SUBROUTINE DPLOEX(ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE, 1IHPNV,IHPNV2,ILOCPN,ASTARV,AINCV,ASTOPV,NUMLOI,ILOOIT, 1ILOOSP,ILOOEP,IANSLO,IWIDLL,MAXLIL,MAXCIL, 1IANS,IANSLC,IWIDTH, 1ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2, 1IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM, CCCCC FEBRUARY 1994, ADD FOLLOWING LINE 1IN,IIFSW,NUMIF, 1IHOST1,IHOST2, 1IBUGLO,IBUGTY,ISUBRO,IERROR) C C PURPOSE--EXECUTE THE COMMANDS IN A LOOP C (THESE COMMANDS HAVE BEEN AUTOMATICALLY STORED). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--DECEMBER 1982 C UPDATED --APRIL 1989 ADD ISUBRO AS AN ARGUMENT C UPDATED --FEBRUARY 1994 FIX BUG THAT DELETE IN LOOP WIPED C OUT LOOP INDEX PARAMETER C UPDATED --FEBRUARY 1994 ADD BREAK LOOP COMMAND C UPDATED --JANUARY 2005 FOR LOOPS OF TYPE C LOOP FOR K = 3 1 2 C MODIFY SO THAT LOOP NOT EXECUTED C AND SET INDEX VALUE TO START C VALUE C UPDATED --FEBRUARY 2006 USE MAXCIL (RATHER THAN 80) AS C THE MAXIMUM NUMBER OF C CHARACTERS PER LINE IN LOOP C UPDATED --FEBRUARY 2006 BUG IN BREAK LOOP WHEN BREAK C OCCURS IN FIRST ITERATION OF C THE LOOP C C--------------------------------------------------------------------- C CCCCC INCLUDE 'DPCOPA.INC' CHARACTER*4 ILOOST C CHARACTER*4 IHPNV CHARACTER*4 IHPNV2 CHARACTER*4 IANSLO C CHARACTER*4 IANS CHARACTER*4 IANSLC CHARACTER*4 ICOM CHARACTER*4 ICOM2 CHARACTER*4 ICOMT CHARACTER*4 ICOMLC CHARACTER*4 ICOML2 CHARACTER*4 IHARG CHARACTER*4 IHARG2 CHARACTER*4 IARGT CHARACTER*4 IHARLC CHARACTER*4 IHARL2 C CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE C CHARACTER*4 IHOST1 CHARACTER*4 IHOST2 C CHARACTER*4 IBUGLO CHARACTER*4 IBUGTY CCCCC THE FOLLOWING LINE WAS INSERTED APRIL 1989 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 IH CHARACTER*4 IH2 C CHARACTER*4 IHPN CHARACTER*4 IHPN2 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 IFOUNF CCCCC ADD FOLLOWING LINE. FEBRUARY 1994. CHARACTER*4 IIFSW C DIMENSION IHPNV(*) DIMENSION IHPNV2(*) DIMENSION ILOCPN(*) DIMENSION ASTARV(*) DIMENSION AINCV(*) DIMENSION ASTOPV(*) DIMENSION NUMLOI(*) DIMENSION ILOOIT(*) DIMENSION ILOOSP(*) DIMENSION ILOOEP(*) DIMENSION IANSLO(MAXLIL,MAXCIL) DIMENSION IWIDLL(*) C DIMENSION IANS(*) DIMENSION IANSLC(*) DIMENSION IHARG(*) DIMENSION IHARG2(*) DIMENSION IARGT(*) DIMENSION IARG(*) DIMENSION ARG(*) DIMENSION IHARLC(*) DIMENSION IHARL2(*) C DIMENSION IHNAME(*) DIMENSION IHNAM2(*) DIMENSION IUSE(*) DIMENSION IVALUE(*) DIMENSION VALUE(*) CCCCC FEBRUARY 1994. ADD FOLLOWING LINE DIMENSION IN(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLO' ISUBN2='EX ' C J12=0 C IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLOEX--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGLO,IBUGTY,IERROR 52 FORMAT('IBUGLO,IBUGTY,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE 53 FORMAT('ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE = ',A4,4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NUMLOE,NUMENE,NUMLIL,MAXCIL 54 FORMAT('NUMLOE,NUMENE,NUMLIL,MAXCIL = ',4I8) DO55I=1,10 WRITE(ICOUT,56)I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I), 1 ILOOEP(I) 56 FORMAT('I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),', 1 'ILOOEP(I) =',I8,2X,A4,2X,A4,I8,I8,I8) CALL DPWRST('XXX','BUG ') 55 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO60I=1,10 WRITE(ICOUT,61)I,ASTARV(I),AINCV(I),ASTOPV(I), 1 NUMLOI(I),ILOOIT(I) 61 FORMAT('I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I),', 1 'ILOOIT(I) =',I8,3E15.7,2I8) CALL DPWRST('XXX','BUG ') 60 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO65I=1,NUMLIL WRITE(ICOUT,66)I,IWIDLL(I) 66 FORMAT('I,IWIDLL(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') JMAX=IWIDLL(I) WRITE(ICOUT,67)(IANSLO(I,J),J=1,MIN(80,JMAX)) 67 FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1) CALL DPWRST('XXX','BUG ') 65 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)IWIDTH,ICOM,ICOM2,NUMARG 71 FORMAT('IWIDTH,ICOM,ICOM2,NUMARG = ',I8,2X,A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,72)ICOMLC,ICOML2 72 FORMAT('ICOMLC,ICOML2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)(IANS(I),I=1,IWIDTH) 73 FORMAT('(IANS(I),I=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,74)(IANSLC(I),I=1,IWIDTH) 74 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') DO75I=1,NUMNAM WRITE(ICOUT,76)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) 76 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ', 1 I8,2X,A4,2X,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,77)I,IHARLC(I),IHARL2(I) 77 FORMAT('I,IHARLC(I),IHARL2(I) = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 75 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO80I=1,NUMNAM WRITE(ICOUT,81)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I), 1 VALUE(I) 81 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),', 1 'VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') 80 CONTINUE C ENDIF C C ************************************************* C ** STEP 1-- ** C ** IF ENTRY IS FROM OUTSIDE THIS SUBROUTINE, ** C ** THEN INCREMENT THE LOOP LINE NUMBER ** C ** WHICH SPECIFIES WHICH LINE OF THE LOOP ** C ** WILL BE EXAMINED AND EXECUTED. ** C ************************************************* C ILOOLI=ILOOLI+1 C C ********************************************** C ** STEP 2-- ** C ** COPY THE STORED LINE BACK INTO IANS(.) ** C ********************************************** C 1200 CONTINUE C ISTEPN='2' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C DO1230J=1,MAXCIL IANS(J)=' ' IANSLC(J)=' ' 1230 CONTINUE C IWIDTH=IWIDLL(ILOOLI) DO1250J=1,IWIDTH IANSLC(J)=IANSLO(ILOOLI,J) 1250 CONTINUE CALL DPUPPE(IANSLC,IWIDTH,IANS,IBUGLO,IERROR) C IF(IBUGLO.EQ.'ON' .OR. ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1261) 1261 FORMAT('--------------------') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1262)ILOOLI 1262 FORMAT('CURRENT LINE NUMBER ILOOLI = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1263)(IANSLC(I),I=1,MIN(IWIDTH,80)) 1263 FORMAT('(IANSLC(I),I=1,80) = ',80A1) CALL DPWRST('XXX','BUG ') ENDIF C C ****************************************** C ** STEP 3-- ** C ** EXTRACT THE COMMAND NAME AND ** C ** SEPARATE OUT THE VARIOUS ARGUMENTS ** C ****************************************** C ISTEPN='3' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL DPTYPE(IANSLC,IWIDTH,IBUGTY, 1ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2, 1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM, 1IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG, 1IHOST1,IHOST2) C C ****************************************** C ** STEP 4-- ** C ** SEARCH FOR LOOP COMMAND ** C ** AND BRANCH ACCORDINGLY; ** C ** SEARCH FOR END OF LOOP COMMAND ** C ** AND BRANCH ACCORDINGLY; ** C ** IF NEITHER, THEN JUMP TO EXIT ** C ** FOR NORMAL PROCESSING. ** C ****************************************** C C ISTEPN='4' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,1401)ICOM,ILOOLI 1401 FORMAT('ICOM,ILOOLI = ',A4,I8) CALL DPWRST('XXX','BUG ') ENDIF C C BUG FIX: ALLOW IF COMMANDS TO BE NESTED WITHIN LOOP (AUGUST, 1987) C SO SPECIFICALLY CHECK FOR "END LOOP" TO AVOID CONFLICT C WITH "END IF" C FEBRUARY 1994. BREAK LOOP COMMAND. C IF(ICOM.EQ.'LOOP')THEN GOTO1400 C C ************************************************* C ** STEP 6-- ** C ** TREAT THE CASE WHEN COMMAND = END OF LOOP ** C ** NUMENE = NUMBER OF END OF LOOP ** C ** COMMANDS ENCOUNTERED ** C ************************************************* C ELSEIF( 1 (ICOM.EQ.'END'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') .OR. 1 (ICOM.EQ.'END'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'LOOP'))THEN ISTEPN='6' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMENE=NUMENE+1 ILOOEP(NUMLOE)=ILOOLI GOTO1700 ELSEIF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') 1 THEN IF(IIFSW.EQ.'TRUE')THEN IF(NUMIF.GT.0)NUMIF=NUMIF-1 GOTO1700 ELSE GOTO9000 ENDIF ENDIF GOTO9000 C C ********************************************** C ** STEP 4.1-- ** C ** TREAT THE CASE WHEN THE COMMAND = LOOP ** C ** NUMLOE = NUMBER OF LOOP COMMANDS ** C ** ENCOUNTERED ** C ********************************************** C 1400 CONTINUE ISTEPN='4.1' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMLOE=NUMLOE+1 C C DECEMBER 2006: WHEN IF SWITCH IS FALSE, DO NOT C PROCESS LOOP COMMAND. C IF(IIFSW.EQ.'FALS')GOTO9000 C C ********************************************* C ** STEP 4.2-- ** C ** SEARCH FOR FIRST OCCURRANCE OF FOR ** C ********************************************* C ISTEPN='4.2' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C JMAX=NUMARG-1 DO1405J=1,JMAX J2=J JP1=J+1 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' '.AND. 1 IHARG(JP1).EQ.'I '.AND.IHARG2(JP1).EQ.' ')GOTO1430 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ')GOTO1450 1405 CONTINUE GOTO1410 C C ********************************************** C ** STEP 4.3A-- ** C ** TREAT THE CASE WHERE FOR NOT FOUND ** C ********************************************** C 1410 CONTINUE ISTEPN='4.3A' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) KMIN=1 ASTART=KMIN KDEL=1 AINC=KDEL KMAX=1 ASTOP=KMAX NUMINC=1 C IHPN='I ' IHPN2=' ' IHPNV(NUMLOE)=IHPN IHPNV2(NUMLOE)=IHPN2 ASTARV(NUMLOE)=ASTART AINCV(NUMLOE)=AINC ASTOPV(NUMLOE)=ASTOP ILOOSP(NUMLOE)=ILOOLI NUMLOI(NUMLOE)=NUMINC IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1412) 1412 FORMAT('THIS IS THE NO FOR CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1413)ILOOLI 1413 FORMAT('ILOOLI = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1414)IHPNV(NUMLOE),IHPNV2(NUMLOE) 1414 FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1415)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) 1415 FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ', 1 3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1416)ILOOSP(NUMLOE),ILOOEP(NUMLOE) 1416 FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1417)NUMLOI(NUMLOE),ILOOIT(NUMLOE) 1417 FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF GOTO1490 C C ********************************** C ** STEP 4.3B-- ** C ** TREAT THE FOR I CASE ** C ********************************** C 1430 CONTINUE ISTEPN='4.3B' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C JP3=JP1+2 JP4=JP1+3 JP5=JP1+4 KMIN=1 IF(JP3.LE.NUMARG)KMIN=IARG(JP3) ASTART=KMIN KDEL=1 IF(JP4.LE.NUMARG)KDEL=IARG(JP4) AINC=KDEL KMAX=KMIN IF(JP5.LE.NUMARG)KMAX=IARG(JP5) ASTOP=KMAX NUMINC=((KMAX-KMIN)/KDEL)+1 C IHPN='I ' IHPN2=' ' IHPNV(NUMLOE)=IHPN IHPNV2(NUMLOE)=IHPN2 ASTARV(NUMLOE)=ASTART AINCV(NUMLOE)=AINC ASTOPV(NUMLOE)=ASTOP ILOOSP(NUMLOE)=ILOOLI NUMLOI(NUMLOE)=NUMINC IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1432) 1432 FORMAT('THIS IS THE FOR I CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1433)ILOOLI 1433 FORMAT('ILOOLI = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1434)IHPNV(NUMLOE),IHPNV2(NUMLOE) 1434 FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1435)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) 1435 FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ', 1 3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1436)ILOOSP(NUMLOE),ILOOEP(NUMLOE) 1436 FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1437)NUMLOI(NUMLOE),ILOOIT(NUMLOE) 1437 FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF GOTO1490 C C ******************************************* C ** STEP 4.3C-- ** C ** TREAT THE GENERAL FOR CASE ** C ******************************************* C 1450 CONTINUE ISTEPN='4.3C' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IFOLOC=J2 ILALOC=IFOLOC-1 C IF(IPRINT.EQ.'ON')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') ENDIF DO1460ITER=1,1000 IFOLOC=ILALOC+1 J=IFOLOC JP1=J+1 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' '.AND. 1 IHARG(JP1).EQ.'I '.AND.IHARG2(JP1).EQ.' ')GOTO1480 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ')GOTO1470 GOTO1490 1470 CONTINUE C CALL DPEXS2(IFOLOC,IHARG,IHARG2,IARGT,IARG,ARG,NUMARG, 1IANS,IWIDTH, 1IHPN,IHPN2,ASTART,AINC,ASTOP,NUMINC,ILALOC,IBUGLO,IFOUNF,IERROR) C IF(IFOUNF.EQ.'NO')GOTO1490 IHPNV(NUMLOE)=IHPN IHPNV2(NUMLOE)=IHPN2 ASTARV(NUMLOE)=ASTART AINCV(NUMLOE)=AINC ASTOPV(NUMLOE)=ASTOP ILOOSP(NUMLOE)=ILOOLI NUMLOI(NUMLOE)=NUMINC IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1472) 1472 FORMAT('THIS IS THE GENERAL FOR CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1473)ILOOLI 1473 FORMAT('ILOOLI = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1474)IHPNV(NUMLOE),IHPNV2(NUMLOE) 1474 FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1475)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) 1475 FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ', 1 3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1476)ILOOSP(NUMLOE),ILOOEP(NUMLOE) 1476 FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1477)NUMLOI(NUMLOE),ILOOIT(NUMLOE) 1477 FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF 1460 CONTINUE C 1480 CONTINUE C C *************************************** C ** STEP 4.4-- ** C ** WRITE OUT A MESSAGE INDICATING ** C ** THE TOTAL NUMBER OF ITERATIONS. ** C *************************************** C 1490 CONTINUE ISTEPN='4.4' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IPROD=1 IF(NUMLOE.GT.0)THEN DO1491I=1,NUMLOE IPROD=IPROD*NUMLOI(I) 1491 CONTINUE ENDIF C NUMLAP=IPROD IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,1496)NUMLOI(NUMLOE),IPROD 1496 FORMAT('NUMLOI(NUMLOE),IPROD = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF C ILOOIT(NUMLOE)=0 GOTO1700 C C ************************************************* C ** STEP 7.1-- ** C ** FOR BOTH THE LOOP COMMAND, ** C ** AND THE END OF LOOP COMMAND, ** C ** COMPUTE THE NEXT VALUE FOR THIS PARAMETER ** C ************************************************* C 1700 CONTINUE ISTEPN='7.1' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ILOOIT(NUMLOE)=ILOOIT(NUMLOE)+1 ITER=ILOOIT(NUMLOE) AITER=ITER PV=ASTARV(NUMLOE)+(AITER-1.0)*AINCV(NUMLOE) N1=NUMLOI(NUMLOE) CCCCC IF(ITER.EQ.N1)PV=ASTOPV(NUMLOE) APRIL 27, 1987 C FIX AUGUST, 1987 C LOOP GETS INCREMENTED ONCE PAST LAST VALUE. ADJUST STOP VALUE C SO THAT WHEN EXIT LOOP, HAS LAST "GOOD" VALUE IF(ITER.GT.N1)PV=PV-AINCV(NUMLOE) C END FIX CCCCC ADD FOLLOWING BLOCK FOR BREAK LOOP COMMAND. FEBRUARY 1994. IF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN ITER=N1+1 PV=PV-AINCV(NUMLOE) END IF CCCCC JANUARY 2005: IF HAVE SOMETHING LIKE CCCCC CCCCC LOOP FOR K = 3 1 2 CCCCC CCCCC THEN WE WANT TO TERMINATE LOOP WITHOUT CCCCC EXECUTING IT. C IF(AINCV(NUMLOE).GT.0)THEN IF(ASTOPV(NUMLOE).LT.ASTARV(NUMLOE))THEN ITER=N1+1 PV=ASTARV(NUMLOE) ENDIF ELSEIF(AINCV(NUMLOE).LT.0)THEN IF(ASTOPV(NUMLOE).GT.ASTARV(NUMLOE))THEN ITER=N1+1 PV=ASTARV(NUMLOE) ENDIF ENDIF C IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') IF(ICOM.EQ.'END')THEN WRITE(ICOUT,1712) 1712 FORMAT('AN END OF LOOP LINE HAS BEEN ENCOUNTERED') CALL DPWRST('XXX','BUG ') ENDIF WRITE(ICOUT,1713)NUMLOE,ILOOLI,ICOM 1713 FORMAT('NUMLOE,ILOOLI,ICOM = ',2I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1714)IHPNV(NUMLOE),IHPNV2(NUMLOE) 1714 FORMAT('IHPNV(NUMLOE),IHPNV2(NUMLOE) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1715)ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) 1715 FORMAT('ASTARV(NUMLOE),AINCV(NUMLOE),ASTOPV(NUMLOE) = ', 1 3E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1716)ILOOSP(NUMLOE),ILOOEP(NUMLOE) 1716 FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1717)NUMLOI(NUMLOE),ILOOIT(NUMLOE) 1717 FORMAT('NUMLOI(NUMLOE),ILOOIT(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1718)ITER,N1,PV 1718 FORMAT('ITER,N1,PV = ',I8,I8,E15.7) CALL DPWRST('XXX','BUG ') ENDIF C C **************************************** C ** STEP 7.2-- ** C ** FOR BOTH THE LOOP COMMAND, ** C ** AND THE END OF LOOP COMMAND, ** C ** DEFINE THE NEXT LINE OF THE LOOP ** C ** TO BE EXAMINED ** C **************************************** C ISTEPN='7.2' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C WRITE(ICOUT,1705)ILOOLI,ITER,N1,NUMLOE 1705 FORMAT('ILOOLI,ITER,N1,NUMLOE = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1706)ILOOSP(NUMLOE),ILOOEP(NUMLOE) 1706 FORMAT('ILOOSP(NUMLOE),ILOOEP(NUMLOE) = ',2I8) CALL DPWRST('XXX','BUG ') ENDIF C ILOOLI=ILOOSP(NUMLOE)+1 IF(ITER.GT.N1)ILOOLI=ILOOEP(NUMLOE)+1 CCCCC ADD FOLLOWING BLOCK FOR BREAK LOOP COMMAND. FEBRUARY 1994. CCCCC BUG. BREAK LOOP NORMALLY IN IF BLOCK, WHEN THERE IS ERROR CCCCC IN IF STATEMENT (OR THERE IS NO IF), THEN GET SEG FAULT CCCCC BECAUSE ILOOEP NOT YET DEFINED (I.E., BREAK LOOP ENCOUNTERED CCCCC BEFORE END OF LOOP, NEED AT LEAST ONE ITERATION THROUGH LOOP). CCCCC IF(ILOOEP(NUMLOE).GT.0)THEN IF(ICOM.EQ.'BREA'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP')THEN ILOOLI=ILOOEP(NUMLOE)+1 END IF CCCCC ELSE CCCCC ENDIF C BUG FIX: AUGUST, 1987 FOLLOWING 2 LINES MOVED TO CORRECT PROBLEM C WITH NESTED LOOPS. FOR NESTED LOOPS, VALUE OF INNER LOOP IS ASSIGNED C TO OUTER LOOP C DR. FILLIBEN CORRECTED PROBLEM ELSEWHERE. UNCOMMENT THIS FIX C CCCCC IF(ITER.GT.N1)NUMLOE=NUMLOE-1 CCCCC IF(ITER.GT.N1)NUMENE=NUMENE-1 C C ******************************************* C ** STEP 7.3-- ** C ** FOR BOTH THE LOOP COMMAND, ** C ** AND THE END OF LOOP COMMAND, ** C ** IF THE NEXT LINE TO BE EXAMINED IS ** C ** BEYOND THE LOOP TABLE, THEN ** C ** THE LOOPING IS COMPLETED-- ** C ** BRANCH TO RESET ALL LOOP VARIABLES. ** C ******************************************* C ISTEPN='7.3' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC BUG FIX. ADD FOLLOWING LINE. JANUARY 1999. CCCCC BUG IS IF NO IF AROUND BREAK LOOP (WHICH ALSO OCCURS CCCCC IF THERE IS AN ERROR IN THE IF) IF(ILOOLI.LT.0)GOTO1800 IF(ILOOLI.GT.NUMLIL)GOTO1800 C C ******************************************** C ** STEP 7.4-- ** C ** FOR BOTH THE LOOP COMMAND, ** C ** AND THE END OF LOOP COMMAND, ** C ** ENTER THE TERMPORARY VALUE FOR ** C ** FOR THE LOOP PARAMETER ** C ** INTO THE PERMANENT INTERNAL DATAPLOT ** C ** NAME TABLE. ** C ******************************************** C C ISTEPN='7.4' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C C **************************************************** C ** STEP 7.5-- ** C ** IS THIS A LOOP COMMAND? ** C ** IF SO, SEARCH THE INTERNAL DATAPLOT ** C ** NAME TABLE FOR THE PARAMETER NAME. ** C ** IF NOT, THEN THE NAME SHOULD ALREADY HAVE ** C ** BEEN ENTERED ** C ** INTO THE INTERNAL DATAPLOT NAME TABLE. ** C **************************************************** C ISTEPN='7.5' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC IF(ITER.LE.1)GOTO1720 IF(ICOM.EQ.'LOOP')GOTO1720 GOTO1760 C 1720 CONTINUE C IH=IHPNV(NUMLOE) IH2=IHPNV2(NUMLOE) IF(NUMNAM.LE.0)GOTO1729 DO1725J1=1,NUMNAM J12=J1 IF(IH.EQ.IHNAME(J1).AND.IH2.EQ.IHNAM2(J1))THEN ILOCPN(NUMLOE)=J12 GOTO1760 ENDIF 1725 CONTINUE 1729 CONTINUE IF(NUMNAM.GE.MAXNAM)THEN C WRITE(ICOUT,1731) 1731 FORMAT('***** ERROR IN LOOP EXECUTION--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1732) 1732 FORMAT(' THE NUMBER OF DATAPLOT NAMES HAS JUST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1734)MAXNAM 1734 FORMAT(' EXCEEDED THE ALLOWABLE MAXIMUM OF ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1735) 1735 FORMAT(' THIS OCCURRED IN ATTEMPTING TO ENTER ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1736)IH,IH2 1736 FORMAT(' THE PARAMETER NAME ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1737) 1737 FORMAT(' INTO THE INTERNAL DATAPLOT NAME LIST.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1738) 1738 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1739)(IANS(I),I=1,MIN(100,IWIDTH)) 1739 FORMAT(' ',100A1) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C C ******************************************** C ** STEP 7.6-- ** C ** ENTER LOOP PARAMETER VALUE ** C ** INTO PERMANENT INTERNAL DATAPLOT ** C ** NAME TABLE. ** C ** TREAT THE CASE WHERE COMMAND = LOOP ** C ** AND PARAMETER NAME NOT YET EXIST ** C ** IN GENERAL DATAPLOT NAME TABLE. ** C ******************************************** C 1750 CONTINUE C ISTEPN='7.6' IF(ISUBRO.EQ.'LOEX')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMNAM=NUMNAM+1 J12=NUMNAM ILOCPN(NUMLOE)=J12 IHNAME(J12)=IH IHNAM2(J12)=IH2 IUSE(J12)='P' C VALUE(J12)=PV IVALUE(J12)=PV+0.5 CCCCC ADD FOLLOWING LINE FOR DELETE IN LOOP BUG. FEBRUARY 1994. IN(J12)=1 GOTO1780 C C **************************************** C ** STEP 7.7-- ** C ** ENTER LOOP PARAMETER VALUE C ** INTO PERMANENT INTERNAL DATAPLOT C ** NAME TABLE. C ** TREAT THE CASE WHERE COMMAND = LOOP C ** OR COMMAND = END OF LOOP, AND C ** PARAMETER NAME ALREADY IN TABLE. C **************************************** C 1760 CONTINUE ISTEPN='7.7' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) WRITE(ICOUT,1761)J12,PV 1761 FORMAT('J12,PV = ',I8,E15.7) CALL DPWRST('XXX','BUG ') ENDIF C CCCCC IF(ITER.GT.N1)GOTO1780 C J12=ILOCPN(NUMLOE) VALUE(J12)=PV IVALUE(J12)=PV+0.5 CCCCC ADD FOLLOWING LINE FOR DELETE IN LOOP BUG. FEBRUARY 1994. IN(J12)=1 C BUG FIX: WRONG LOOP PARAMETER WAS SET C FOLLOWING 2 LINES MOVED FROM ELSEWHERE IN THE ROUTINE C DR. FILLIBEN FIXED PROBLEM ELSEWHERE 9/87, COMMENT OUT MY C CHANGE. IF(ITER.GT.N1)THEN NUMLOE=NUMLOE-1 NUMENE=NUMENE-1 ENDIF C END FIX GOTO1780 C 1780 CONTINUE IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,1781)ITER,N1,J12,PV 1781 FORMAT('ITER,N1,J12,PV = ',3I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1782)J12,IVALUE(J12),VALUE(J12) 1782 FORMAT('J12,IVALUE(J12),VALUE(J12) = ',I8,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1783)NUMLOE 1783 FORMAT('NUMLOE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1784)NUMLOI(1) 1784 FORMAT('NUMLOI(1) = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1785)ASTARV(1),AINCV(1),ASTOPV(1) 1785 FORMAT('ASTARV(1),AINCV(1),ASTOPV(1) = ',3E15.7) CALL DPWRST('XXX','BUG ') ENDIF C 1790 CONTINUE C GOTO1200 C C *********************************************** C ** STEP 7.10-- ** C ** THE EXECUTION OF ALL LOOPS IS COMPLETED; ** C ** RESET LOOPING VARIABLES. ** C *********************************************** C 1800 CONTINUE ILOOST='OFF' ILOOLI=0 NUMLIL=0 NUMLOE=0 NUMENE=0 C DO1810I=1,10 IHPNV(I)=' ' IHPNV2(I)=' ' ILOCPN(I)=-99 ASTARV(I)=-99.0 AINCV(I)=-99.0 ASTOPV(I)=-99.0 NUMLOI(I)=0 ILOOIT(I)=0 ILOOSP(I)=-99 ILOOEP(I)=-99 1810 CONTINUE C DO1820I=1,25 IWIDLL(I)=0 DO1830J=1,MAXCIL IANSLO(I,J)=' ' 1830 CONTINUE 1820 CONTINUE C GOTO9000 C C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOEX')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLOEX--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGLO,IBUGTY,IERROR 9012 FORMAT('IBUGLO,IBUGTY,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE 9013 FORMAT('ILOOST,ILOOLI,NUMLIL,NUMLOE,NUMENE = ',A4,4I8) CALL DPWRST('XXX','BUG ') DO9015I=1,10 WRITE(ICOUT,9016)I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I), 1 ILOOEP(I) 9016 FORMAT('I,IHPNV(I),IHPNV2(I),ILOCPN(I),ILOOSP(I),', 1 'ILOOEP(I) =',I8,2X,A4,2X,A4,I8,I8,I8) CALL DPWRST('XXX','BUG ') 9015 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9020I=1,10 WRITE(ICOUT,9021)I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I), 1 ILOOIT(I) 9021 FORMAT('I,ASTARV(I),AINCV(I),ASTOPV(I),NUMLOI(I),', 1 'ILOOIT(I) =',I8,3E15.7,2I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9025I=1,NUMLIL WRITE(ICOUT,9026)I,IWIDLL(I) 9026 FORMAT('I,IWIDLL(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') JMAX=IWIDLL(I) WRITE(ICOUT,9027)(IANSLO(I,J),J=1,MIN(80,JMAX)) 9027 FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1) CALL DPWRST('XXX','BUG ') 9025 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)IWIDTH,ICOM,ICOM2,NUMARG 9031 FORMAT('IWIDTH,ICOM,ICOM2,NUMARG = ',I8,2X,A4,2X,A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9032)ICOMLC,ICOML2 9032 FORMAT('ICOMLC,ICOML2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9033)(IANS(I),I=1,IWIDTH) 9033 FORMAT('(IANS(I),I=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9034)(IANSLC(I),I=1,IWIDTH) 9034 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') DO9035I=1,NUMNAM WRITE(ICOUT,9036)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) 9036 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ', 1 I8,2X,A4,2X,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9037)I,IHARLC(I),IHARL2(I) 9037 FORMAT('I,IHARLC(I),IHARL2(I) = ',I8,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9035 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') DO9040I=1,NUMNAM WRITE(ICOUT,9041)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I), 1 VALUE(I) 9041 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),', 1 'VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7) CALL DPWRST('XXX','BUG ') 9040 CONTINUE ENDIF C RETURN END SUBROUTINE DPLODG(IHARG,IARGT,ARG,NUMARG, 1ALOWDG,IFOUND,IERROR) C C PURPOSE--DEFINE THE DEGREE (1 FOR LINEAR, 2 FOR QUADRATIC) C TO BE USED FOR THE LOWESS SMOOTHER. C THE SPECIFIED LOWESS DEGREE VALUE WILL BE PLACED C IN THE FLOATING POINT VARIABLE ALOWDG. C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --IARGT (A HOLLERITH VECTOR) C --ARG (A FLOATING POINT VECTOR) C --NUMARG (AN INTEGER VARIABLE) C OUTPUT ARGUMENTS--ALOWDG (A FLOATING POINT VARIABLE) C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--94/3 C ORIGINAL VERSION--MARCH 1994. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHARG CHARACTER*4 IARGT CHARACTER*4 IFOUND CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IHARG(*) DIMENSION IARGT(*) DIMENSION ARG(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C IF(NUMARG.EQ.0)GOTO9000 IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEGR')GOTO1110 IF(IHARG(NUMARG).EQ.'?')GOTO8100 GOTO9000 C 1110 CONTINUE IF(IHARG(NUMARG).EQ.'DEGR')GOTO1150 IF(IHARG(NUMARG).EQ.'ON')GOTO1150 IF(IHARG(NUMARG).EQ.'OFF')GOTO1150 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150 IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160 GOTO1120 C 1120 CONTINUE IERROR='YES' WRITE(ICOUT,1121) 1121 FORMAT('***** ERROR IN DPLODG--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT(' ILLEGAL FORM FOR LOWESS DEGREE COMMAND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1130) 1130 FORMAT(' THE ALLOWABLE FORMS ARE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1131) 1131 FORMAT(' LOWESS DEGREE 1 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1132) 1132 FORMAT(' LOWESS DEGREE 2 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1135) 1135 FORMAT(' THE DEFAULT DEGREE IS 1 (= LINEAR LOWESS)') CALL DPWRST('XXX','BUG ') GOTO9000 C 1150 CONTINUE HOLD=1.0 GOTO1180 C 1160 CONTINUE HOLD=ARG(NUMARG) IF(HOLD.LE.1.5)HOLD=1.0 IF(HOLD.GT.1.5)HOLD=2.0 GOTO1180 C 1180 CONTINUE IFOUND='YES' ALOWDG=HOLD C IF(IFEEDB.EQ.'OFF')GOTO1289 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1281)ALOWDG 1281 FORMAT('THE LOWESS DEGREE HAS JUST BEEN SET ', 1'TO ',F10.4) 1289 CONTINUE GOTO9000 C C ******************************************** C ** STEP 81-- ** C ** TREAT THE ? CASE-- ** C ** DUMP OUT CURRENT AND DEFAULT VALUES. ** C ******************************************** C 8100 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8111)ALOWDG 8111 FORMAT('THE CURRENT LOWESS DEGREE IS ',F10.4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8121) 8121 FORMAT('THE DEFAULT LOWESS DEGREE IS 1.0') CALL DPWRST('XXX','BUG ') GOTO9000 C 9000 CONTINUE RETURN END SUBROUTINE DPLOFR(IHARG,IARGT,ARG,NUMARG, 1ALOWFR,IFOUND,IERROR) C C PURPOSE--DEFINE THE FRACTION (0.0 TO 1.0). C TO BE USED FOR THE LOWESS SMOOTHER. C THE SPECIFIED LOWESS FRACTION VALUE WILL BE PLACED C IN THE FLOATING POINT VARIABLE ALOWFR. C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --IARGT (A HOLLERITH VECTOR) C --ARG (A FLOATING POINT VECTOR) C --NUMARG (AN INTEGER VARIABLE) C OUTPUT ARGUMENTS--ALOWFR (A FLOATING POINT VARIABLE) C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/1 C ORIGINAL VERSION--DECEMBER 1988. C UPDATED --NOVEMBER 1989. CHECK LOWESS FRACTION 0 TO 1 C UPDATED --NOVEMBER 1989. LOWESS FRACTION DEFAULT TO .1 C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IHARG CHARACTER*4 IARGT CHARACTER*4 IFOUND CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IHARG(*) DIMENSION IARGT(*) DIMENSION ARG(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUND='NO' IERROR='NO' C IF(NUMARG.EQ.0)GOTO9000 IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO9000 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FRAC')GOTO1110 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO1110 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PROP')GOTO1110 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PERC')GOTO1110 IF(IHARG(NUMARG).EQ.'?')GOTO8100 GOTO9000 C 1110 CONTINUE IF(IHARG(NUMARG).EQ.'FRAC')GOTO1150 IF(IHARG(NUMARG).EQ.'DECI')GOTO1150 IF(IHARG(NUMARG).EQ.'PROP')GOTO1150 IF(IHARG(NUMARG).EQ.'PERC')GOTO1150 IF(IHARG(NUMARG).EQ.'ON')GOTO1150 IF(IHARG(NUMARG).EQ.'OFF')GOTO1150 IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150 IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160 GOTO1120 C 1120 CONTINUE IERROR='YES' WRITE(ICOUT,1121) 1121 FORMAT('***** ERROR IN DPLOFR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1122) 1122 FORMAT(' ILLEGAL FORM FOR LOWESS FRACTION/', 1'DECIMAL/PROPORTION/PERCENTAGE COMMAND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1124) 1124 FORMAT(' EXAMPLE TO DEMONSTRATE THE ', 1'PROPER FORM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1125) 1125 FORMAT(' SUPPOSE THE THE ANALYST IS CARRYING OUT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1126) 1126 FORMAT(' A LOWESS SMOOTH, ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1127) 1127 FORMAT(' AND SUPPOSE THE ANALYST WISHES THE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1128) 1128 FORMAT(' SMOOTHING WINDOW TO BE 20% OF THE X-WIDTH') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1130) 1130 FORMAT(' THEN THE ALLOWABLE FORMS ARE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1131) 1131 FORMAT(' LOWESS FRACTION .2 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1132) 1132 FORMAT(' LOWESS DECIMAL .2 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1133) 1133 FORMAT(' LOWESS PROPORTION 20 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1134) 1134 FORMAT(' LOWESS PERCENTAGE 20 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1135) 1135 FORMAT(' THE DEFAULT FRACTION IS .5 (= 50%)') CALL DPWRST('XXX','BUG ') GOTO9000 C 1150 CONTINUE CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1989 CCCCC HOLD=.5 HOLD=.1 GOTO1180 C 1160 CONTINUE HOLD=ARG(NUMARG) IF(IHARG(1).EQ.'PROP')HOLD=HOLD/100.0 IF(IHARG(1).EQ.'PERC')HOLD=HOLD/100.0 GOTO1180 C 1180 CONTINUE IFOUND='YES' ALOWFR=HOLD CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989 ALOWPR=100.0*ALOWFR C CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989 C ************************************************** C ** CHECK THAT THE LOWESS FRACTION ** C ** IS BETWEEN 0 AND 1 (EXCLUSIVELY) ** C ************************************************** C IF(IHARG(1).EQ.'FRAC')GOTO1210 IF(IHARG(1).EQ.'DECI')GOTO1210 GOTO1229 1210 CONTINUE IF(ALOWFR.GT.0.0.AND.ALOWFR.LE.1.0)GOTO1229 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN DPLOFR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1212) 1212 FORMAT(' ILLEGAL INPUT VALUE FOR THE LOWESS FRACTION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1213) 1213 FORMAT(' THE LOWESS FRACTION (INDICATING THE SIZE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1214) 1214 FORMAT(' OF THE LOWESS NEIGHBORHOOD)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT(' MUST BE LARGER THAN 0.0 AND SMALLER THAN 1.0.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217)ALOWFR 1217 FORMAT(' THE VALUE OF THE LOWESS FRACTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1218) 1218 FORMAT(' CORRECT THIS VALUE VIA THE LOWESS FRACTION ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1219) 1219 FORMAT(' COMMAND, AS IN LOWESS FRACTION .5') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1229 CONTINUE C IF(IHARG(1).EQ.'PROP')GOTO1230 IF(IHARG(1).EQ.'PERC')GOTO1230 GOTO1249 1230 CONTINUE IF(ALOWPR.GT.0.0.AND.ALOWPR.LE.100.0)GOTO1249 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1231) 1231 FORMAT('***** ERROR IN DPLOFR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1232) 1232 FORMAT(' ILLEGAL INPUT VALUE FOR THE LOWESS PROPORTION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1233) 1233 FORMAT(' THE LOWESS PROPORTION (INDICATING THE SIZE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1234) 1234 FORMAT(' OF THE LOWESS NEIGHBORHOOD)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1235) 1235 FORMAT(' MUST BE LARGER THAN 0 AND SMALLER THAN 100.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1236) 1236 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1237)ALOWPR 1237 FORMAT(' THE VALUE OF THE LOWESS PROPORTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1238) 1238 FORMAT(' CORRECT THIS VALUE VIA THE LOWESS PROPORTION ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1239) 1239 FORMAT(' COMMAND, AS IN LOWESS PROPORTION 50') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1249 CONTINUE C IF(IFEEDB.EQ.'OFF')GOTO1289 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') IF(IHARG(1).EQ.'FRAC'.OR.IHARG(1).EQ.'DECI') 1WRITE(ICOUT,1281)ALOWFR 1281 FORMAT('THE LOWESS FRACTION (0.0 TO 1.0) HAS JUST BEEN SET ', 1'TO ',F10.4) IF(IHARG(1).EQ.'FRAC'.OR.IHARG(1).EQ.'DECI') 1CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING 4 LINES WERE INSERTED NOVEMBER 1989 IF(IHARG(1).EQ.'PROP'.OR.IHARG(1).EQ.'PERC') 1WRITE(ICOUT,1282)ALOWPR 1282 FORMAT('THE LOWESS PROPORTION (0 TO 100) HAS JUST BEEN SET ', 1'TO ',F10.4) IF(IHARG(1).EQ.'PROP'.OR.IHARG(1).EQ.'PERC') 1CALL DPWRST('XXX','BUG ') 1289 CONTINUE GOTO9000 C C ******************************************** C ** STEP 81-- ** C ** TREAT THE ? CASE-- ** C ** DUMP OUT CURRENT AND DEFAULT VALUES. ** C ******************************************** C 8100 CONTINUE IFOUND='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8111)ALOWFR 8111 FORMAT('THE CURRENT LOWESS FRACTION IS ',F10.4) CALL DPWRST('XXX','BUG ') ALOWPR=100.0*ALOWFR 8112 FORMAT('THE CURRENT LOWESS PROPORTION IS ',F10.4,' %') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8121) 8121 FORMAT('THE DEFAULT LOWESS FRACTION IS 0.1') CALL DPWRST('XXX','BUG ') 8122 FORMAT('THE DEFAULT LOWESS PROPORTION IS 10 %') GOTO9000 C 9000 CONTINUE RETURN END SUBROUTINE DPLOST(ILOOST,ILOOLI,NUMLIL,NUMLOS,NUMENS, 1IANSLC,IWIDTH,ICOM,IHARG,IHARG2,NUMARG,IANSLO,IWIDLL, 1MAXCIL,MAXLIL, 1IBUGLO,ISUBRO,IERROR) C C PURPOSE--STORE A COMMAND LINE IN A LOOP C FOR FUTURE EXECUTION. C ORIGINAL VERSION--DECEMBER 1982 C UPDATED --DECEMBER 1988. NO STORAGE OF COMMENT LINES C UPDATED --DECEMBER 1988. RESTORE CONTROL IF MAX LINES C UPDATED --FEBRUARY 1989. FIX IF > 80 COLUMNS (ALAN) C C--------------------------------------------------------------------- C CHARACTER*4 ILOOST C CHARACTER*4 IANSLC CHARACTER*4 ICOM CHARACTER*4 IHARG CHARACTER*4 IHARG2 C CHARACTER*4 IANSLO C CHARACTER*4 IBUGLO CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION IANSLC(*) DIMENSION IHARG(*) DIMENSION IHARG2(*) C CCCCC DIMENSION IANSLO(MAXLIL,80) FEBRUARY 1989 DIMENSION IANSLO(MAXLIL,MAXCIL) DIMENSION IWIDLL(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLO' ISUBN2='ST ' C IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLOST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGLO,ISUBRO,IERROR 52 FORMAT('IBUGLO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ILOOST,ICOM 53 FORMAT('ILOOST,ICOM = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NUMLOS,NUMENS 54 FORMAT('NUMLOS,NUMENS = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)ILOOLI,NUMLIL,MAXLIL,MAXCIL 55 FORMAT('ILOOLI,NUMLIL,MAXLIL,MAXCIL = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,58)IWIDTH 58 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)(IANSLC(J),J=1,IWIDTH) 59 FORMAT('(IANSLC(J),J=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') DO65I=1,NUMLIL WRITE(ICOUT,66)I,IWIDLL(I) 66 FORMAT('I,IWIDLL(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') JMAX=IWIDLL(I) WRITE(ICOUT,67)(IANSLO(I,J),J=1,MIN(80,JMAX)) 67 FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1) CALL DPWRST('XXX','BUG ') 65 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') ENDIF C C ************************************** C ** STEP 0-- ** C ** CHECK LOOP STATUS FOR STORE ** C ** CHECK COMMAND FOR LOOP ** C ** BRANCH ACCORDINGLY. ** C ************************************** C IF(ICOM.EQ.'LOOP')THEN C C ******************************* C ** STEP 1-- ** C ** TREAT THE CASE WHEN THE ** C ** CURRENT COMMAND = LOOP ** C ******************************* C ISTEPN='1' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST') 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ILOOST='STOR' ILOOLI=ILOOLI+1 IF(ILOOLI.GT.MAXLIL)GOTO4000 NUMLIL=ILOOLI NUMLOS=NUMLOS+1 IWIDLL(ILOOLI)=IWIDTH JMAX=IWIDTH IF(JMAX.GT.MAXCIL)JMAX=MAXCIL DO1050J=1,JMAX IANSLO(ILOOLI,J)=IANSLC(J) 1050 CONTINUE GOTO9000 C ELSEIF(ILOOST.EQ.'STOR')THEN C C ******************************* C ** STEP 2-- ** C ** TREAT THE CASE WHEN THE ** C ** LOOP STATUS = STORE ** C ******************************* C ISTEPN='2' IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST') 1 CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC THE FOLLOWING LINE WAS ADDED IN DECEMBER 1988 CCCCC TO AVOID STORING COMMENT LINES IN A LOOP (DECEMBER 1988) CCCCC AND THEREBY SAVE SOME STORAGE (DECEMBER 1988) IF(IWIDTH.GE.1.AND.IANSLC(1).EQ.'.')GOTO9000 ILOOLI=ILOOLI+1 IF(ILOOLI.GT.MAXLIL)GOTO4000 NUMLIL=ILOOLI IWIDLL(ILOOLI)=IWIDTH CCCCC THE FOLLOWING 3 LINES WERE ADDED (FEBRUARY 1989) CCCCC TO AVOID PROBLEMS WHEN > 80 COLUMNS (FEBRUARY 1989) JMAX=IWIDTH IF(JMAX.GT.MAXCIL)JMAX=MAXCIL DO2050J=1,JMAX IANSLO(ILOOLI,J)=IANSLC(J) 2050 CONTINUE C C ************************************ C ** STEP 3-- ** C ** TREAT THE CASE WHEN THE ** C ** CURRENT COMMAND = END OF LOOP ** C ************************************ C IF(ICOM.EQ.'END')THEN IF((NUMARG.GE.1.AND.IHARG(1).EQ.'LOOP') .OR. 1 (NUMARG.GE.2.AND.IHARG(2).EQ.'LOOP'))THEN NUMENS=NUMENS+1 IF(NUMENS.EQ.NUMLOS)THEN ILOOST='EXEC' ILOOLI=0 ELSE ILOOST='STOR' ENDIF ENDIF GOTO9000 ELSE GOTO9000 ENDIF ELSE GOTO9000 ENDIF C C **************************** C ** STEP 4-- ** C ** TREAT THE ERROR CASE ** C **************************** C 4000 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4011) 4011 FORMAT('***** ERROR IN LOOP STORE--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4012) 4012 FORMAT(' THE TOTAL NUMBER OF LINES IN ALL NESTED LOOPS') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4014)MAXLIL 4014 FORMAT(' HAS JUST EXCEEDED THE ALLOWABLE MAXIMUM (',I8,')') CALL DPWRST('XXX','WRIT') IF(IWIDTH.GE.1)THEN WRITE(ICOUT,4015) 4015 FORMAT(' THE CURRENT LINE BEING PROCESSED IS') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,4016)(IANSLC(J),J=1,MIN(80,IWIDTH)) 4016 FORMAT(6X,80A1) CALL DPWRST('XXX','WRIT') ENDIF IERROR='YES' C CCCCC THE FOLLOWING 5 LINES WERE ADDED DECEMBER 1988 CCCCC TO GIVE CONTROL BACK TO THE USER (DECEMBER 1988) CCCCC IN CASE HAVE EXCEEDED MAX NUMBER OF LOOP LINES (DECEMBER 1988) ILOOST='OFF' ILOOLI=0 NUMLIL=0 NUMLOS=0 NUMENS=0 C GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGLO.EQ.'ON'.OR.ISUBRO.EQ.'LOST')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLOST--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGLO,ISUBRO,IERROR 9012 FORMAT('IBUGLO,ISUBRO,IERROR = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ILOOST,ICOM 9013 FORMAT('ILOOST,ICOM = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NUMLOS,NUMENS 9014 FORMAT('NUMLOS,NUMENS = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)ILOOLI,NUMLIL,MAXLIL,MAXCIL 9015 FORMAT('ILOOLI,NUMLIL,MAXLIL,MAXCIL = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)IWIDTH 9018 FORMAT('IWIDTH = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)(IANSLC(J),J=1,MIN(80,IWIDTH)) 9019 FORMAT('(IANSLC(J),J=1,IWIDTH) = ',80A1) CALL DPWRST('XXX','BUG ') DO9025I=1,NUMLIL WRITE(ICOUT,9026)I,IWIDLL(I) 9026 FORMAT('I,IWIDLL(I) = ',I8,I8) CALL DPWRST('XXX','BUG ') JMAX=IWIDLL(I) WRITE(ICOUT,9027)(IANSLO(I,J),J=1,MIN(80,JMAX)) 9027 FORMAT('(IANSLO(I,J),J=1,JMAX) = ',80A1) CALL DPWRST('XXX','BUG ') 9025 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') ENDIF C RETURN END SUBROUTINE DPLOW(ALOWFR,ALOWDG, CCCCC ADD ARGUMENT FOR LOWESS DEGREE. MARCH 1994. CCCCC SUBROUTINE DPLOW(ALOWFR, 1XTEMP3,XTEMP4,XTEMP1,XTEMP2,MAXNXT, 1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR) C C PURPOSE--CARRY OUT A LOWESS FIT OF Y ON X. C (USEFUL FOR ADDING A ROBUST SMOOTH LINE C TO A SCATTER PLOT) C NOTE--ALOWFR IS A NUMBER BETWEEN 0.0 AND 1.0 C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88/2 C ORIGINAL VERSION--FEBRUARY 1988. C UPDATED --MARCH 1988. ADD LOFCDF C UPDATED --JANUARY 1988. DECLARE ICTAR1&2 AS CHARACTER C UPDATED --NOVEMBER 1989. ALLOW SINGLE VARIABLE C UPDATED --NOVEMBER 1989. CHECK LOWESS FRACTION 0 TO 1 C UPDATED --JUNE 1990. TEMPORARY ARRAYS TO GARBAGE COMMON C UPDATED --APRIL 1992. COMMENT OUT 2 DEBUG LINES C UPDATED --APRIL 1992. NPLOTP TO NS IN DEBUG SECTION C UPDATED --MARCH 1994. ADD ARGUMENT C UPDATED --FEBRUARY 1999. ADD SEASONAL LOESS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASAN CHARACTER*4 IBUGA2 CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 ISUBRO CHARACTER*4 IFOUND CHARACTER*4 IERROR C CHARACTER*4 ICASEQ C CHARACTER*4 IHRI11 CHARACTER*4 IHRI12 CHARACTER*4 IHRI21 CHARACTER*4 IHRI22 CHARACTER*4 IHRIX1 CHARACTER*4 IHRIX2 C CHARACTER*4 IERRO4 C CHARACTER*4 IREP CHARACTER*4 IREPU CHARACTER*4 IRESU C CHARACTER*4 ICTAR1 CHARACTER*4 ICTAR2 C CHARACTER*4 ISUBN0 CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*80 IFILE1 CHARACTER*12 ISTAT1 CHARACTER*12 IFORM1 CHARACTER*12 IACCE1 CHARACTER*12 IPROT1 CHARACTER*12 ICURS1 CHARACTER*4 IERRF1 CHARACTER*4 IENDF1 CHARACTER*4 IREWI1 C CHARACTER*4 IHP CHARACTER*4 IHP2 CHARACTER*4 IHWUSE CHARACTER*4 MESSAG C LOGICAL ROBUST C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C DIMENSION XTEMP1(*) DIMENSION XTEMP2(*) DIMENSION XTEMP3(*) DIMENSION XTEMP4(*) C DIMENSION Y1(MAXOBV) DIMENSION Y2(MAXOBV) DIMENSION W(MAXOBV) C DIMENSION XTEMP5(MAXOBV) DIMENSION XTEMP6(MAXOBV) DIMENSION XTEMP7(MAXOBV) DIMENSION XWORK(10*MAXOBV) C DIMENSION PRED2(MAXOBV) DIMENSION RES2(MAXOBV) CCCCC FOLLOWING LINES ADDED JUNE, 1990 INCLUDE 'DPCOZZ.INC' EQUIVALENCE (GARBAG(IGARB1),Y1(1)) EQUIVALENCE (GARBAG(IGARB2),Y2(1)) EQUIVALENCE (GARBAG(IGARB3),W(1)) EQUIVALENCE (GARBAG(IGARB4),PRED2(1)) EQUIVALENCE (GARBAG(IGARB5),RES2(1)) EQUIVALENCE (GARBAG(IGARB6),XTEMP5(1)) EQUIVALENCE (GARBAG(IGARB7),XTEMP6(1)) EQUIVALENCE (GARBAG(IGARB8),XTEMP7(1)) EQUIVALENCE (GARBAG(IGARB9),XWORK(1)) CCCCC END CHANGE C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' INCLUDE 'DPCOF2.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLO' ISUBN2='W ' C IFOUND='NO' IERROR='NO' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C MINN2=2 C IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PLOW')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ICASAN 53 FORMAT('ICASAN = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IBUGA2,IBUGA3,IBUGQ 54 FORMAT('IBUGA2,IBUGA3,IBUGQ = ', 1A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)ICASAN,MAXN,MAXNXT 56 FORMAT('ICASAN,MAXN,MAXNXT = ',A4,2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IFOUND,IERROR 57 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)ALOWFR 61 FORMAT('ALOWFR = ',E15.7) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C *********************************** C ** TREAT THE LOWESS FIT CASE ** C *********************************** C CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989 C ************************************************** C ** STEP 10-- ** C ** CHECK THAT THE LOWESS FRACTION ** C ** IS BETWEEN 0 AND 1 (EXCLUSIVELY) ** C ************************************************** C IF(ALOWFR.GT.0.0.AND.ALOWFR.LE.1.0)GOTO1090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1011) 1011 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1012) 1012 FORMAT(' ILLEGAL INPUT VALUE FOR THE LOWESS FRACTION.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1013) 1013 FORMAT(' THE LOWESS FRACTION (INDICATING THE SIZE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1014) 1014 FORMAT(' OF THE LOWESS NEIGHBORHOOD)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1015) 1015 FORMAT(' MUST BE LARGER THAN 0.0 AND SMALLER THAN 1.0.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1016) 1016 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1017)ALOWFR 1017 FORMAT(' THE VALUE OF THE LOWESS FRACTION = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1018) 1018 FORMAT(' CORRECT THIS VALUE VIA THE LOWESS FRACTION ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1019) 1019 FORMAT(' COMMAND, AS IN LOWESS FRACTION .5') CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1090 CONTINUE C C *************************** C ** STEP 11-- ** C ** EXTRACT THE COMMAND ** C *************************** C CCCCC FEBRUARY 1999. ADD SUPPORT FOR SEASONAL LOWESS COMMAND. C ISTEPN='11' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICOM.EQ.'LOWE'.OR.ICOM.EQ.'LOES')THEN IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FIT')GOTO1110 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SMOO')GOTO1110 GOTO1190 C 1110 CONTINUE ILASTC=1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) GOTO1190 C 1190 CONTINUE IFOUND='YES' ICASAN='PLOW' ELSEIF(ICOM.EQ.'SEAS')THEN IF(NUMARG.GE.1.AND. 1 (IHARG(1).EQ.'LOWE'.OR.IHARG(1).EQ.'LOES'))THEN ILASTC=1 IF(NUMARG.GE.2.AND.IHARG(2).EQ.'FIT')ILASTC=ILASTC+1 IF(NUMARG.GE.2.AND.IHARG(2).EQ.'SMOO')ILASTC=ILASTC+1 CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG) IFOUND='YES' ICASAN='SLOW' ELSE IFOUND='NO' GOTO9000 ENDIF ELSE IFOUND='NO' GOTO9000 ENDIF C C ******************************************************** C ** STEP 12-- ** C ** CARRY OUT A GENERAL CHECK FOR THE ** C ** PROPER NUMBER OF INPUT ARGUMENTS ** C ** (IT SHOULD BE 1 OR 2). ** C ******************************************************** C ISTEPN='12' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1989 CCCCC MINNA=2 MINNA=1 C MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C ***************************************** C ** STEP 13-- ** C ** CHECK TO SEE THE TYPE CASE-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='13' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO1390 DO1300J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO1310 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO1310 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO1320 1300 CONTINUE GOTO1390 1310 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO1390 1320 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO1390 1390 CONTINUE IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PLOW')GOTO1395 WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8) CALL DPWRST('XXX','BUG ') 1395 CONTINUE C C ******************************************************** C ** STEP 14-- ** C ** CARRY OUT A SPECIFIC CHECK FOR THE ** C ** PROPER NUMBER OF INPUT ARGUMENTS ** C ** (IT SHOULD BE 1 OR 2). ** C ******************************************************** C ISTEPN='14' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMVAR=ILOCQ-1 CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989 IF(ICASAN.EQ.'SLOW')THEN IF(NUMVAR.EQ.1)GOTO1490 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11411) 11411 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11412) 11412 FORMAT(' FOR A SEASONAL LOWESS FIT, ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11418) 11418 FORMAT(' THE NUMBER OF VARIABLES MUST BE 1;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11420) 11420 FORMAT(' SUCH WAS NOT THE CASE HERE;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11421)NUMVAR 11421 FORMAT(' THE SPECIFIED NUMBER OF VARIABLES WAS ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,11423) 11423 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,11424)(IANS(I),I=1,MIN(IWIDTH,80)) 11424 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C IF(NUMVAR.EQ.1)GOTO1490 IF(NUMVAR.EQ.2)GOTO1490 GOTO1410 C 1410 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1411) 1411 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1412) 1412 FORMAT(' FOR A LOWESS FIT, ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1418) 1418 FORMAT(' THE NUMBER OF VARIABLES ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1419) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS CORRECTED NOVEMBER 1989 C1419 FORMAT(' MUST BE EXACTLY 2 ;') 1419 FORMAT(' MUST BE 1 OR 2 ;') WRITE(ICOUT,1420) 1420 FORMAT(' SUCH WAS NOT THE CASE HERE;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1421) 1421 FORMAT(' THE SPECIFIED NUMBER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1422)NUMVAR 1422 FORMAT(' OF VARIABLES WAS ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1423) 1423 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,MIN(IWIDTH,80)) 1424 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1490 CONTINUE C C ******************************************************* C ** STEP 15-- * C ** EXAMINE THE VARIABLES-- * C ** HAS EACH VARIABLE * C ** ALREADY BEEN DEFINED? * C ** NOTE THAT ILISR1, ILISR2, * C ** IS THE LINE IN THE TABLE * C ** OF THE FIRST, SECOND VARIABLE * C ** RESPECTIVELY. * C ** NOTE THAT ICOLR1, ICOLR2, * C ** IS THE DATA COLUMN (1 TO 10+6) * C ** OF THE FIRST, SECOND VARIABLE * C ** RESPECTIVELY. * C ******************************************************* C ISTEPN='15' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICTAR1='FIRS' ICTAR2='T ' ILOCR1=1 IHRI11=IHARG(ILOCR1) IHRI12=IHARG2(ILOCR1) IHRIX1=IHRI11 IHRIX2=IHRI12 DO1510I=1,NUMNAM I2=I IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1519 IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1510 CONTINUE GOTO1570 1519 CONTINUE ILISR1=I2 ICOLR1=IVALUE(ILISR1) NIRIG1=IN(ILISR1) C CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989 IF(NUMVAR.EQ.1)NIRIG2=NIRIG1 IF(NUMVAR.EQ.1)GOTO1590 C ICTAR1='SECO' ICTAR2='ND ' ILOCR2=2 IHRI21=IHARG(ILOCR2) IHRI22=IHARG2(ILOCR2) IHRIX1=IHRI21 IHRIX2=IHRI22 DO1520I=1,NUMNAM I2=I IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'V')GOTO1529 IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND. 1IUSE(I).EQ.'P')GOTO1560 1520 CONTINUE GOTO1570 1529 CONTINUE ILISR2=I2 ICOLR2=IVALUE(ILISR2) NIRIG2=IN(ILISR2) GOTO1590 C 1560 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1561) 1561 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1562)ICTAR1,ICTAR2 1562 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1563) 1563 FORMAT(' WAS FOUND IN THE INTERNAL NAME LIST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1564) 1564 FORMAT(' BUT AS A PARAMETER,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1565) 1565 FORMAT(' AND NOT AS A VARIABLE AS IT SHOULD BE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1567)IHRIX1,IHRIX2 1567 FORMAT(' THE ARGUMENT IN QUESTION WAS ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1568) 1568 FORMAT(' THE COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1569)(IANS(I),I=1,MIN(80,IWIDTH)) 1569 FORMAT(80A1) CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1570 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1571) 1571 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1572)ICTAR1,ICTAR2 1572 FORMAT(' THE SPECIFIED ',A4,A4,' ARGUMENT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1575) 1575 FORMAT(' WAS NOT FOUND IN THE INTERNAL NAME LIST') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1576) 1576 FORMAT(' OF AVAILABLE VARIABLE NAMES.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1577)IHRIX1,IHRIX2 1577 FORMAT(' THE VARIABLE IN QUESTION WAS ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1578) 1578 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,MIN(80,IWIDTH)) 1579 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 1590 CONTINUE C C ****************************************************** C ** STEP 22-- ** C ** CHECK THAT VARIABLES 1 AND 2 HAVE ** C ** THE SAME NUMBER OF ELEMENTS. ** C ****************************************************** C 2100 CONTINUE ISTEPN='21' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NIRIG1.EQ.NIRIG2)GOTO2190 C 2110 CONTINUE WRITE(ICOUT,2111) 2111 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2113) 2113 FORMAT(' THE NUMBER OF OBSERVATIONS IN VARIABLES ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2114) 2114 FORMAT(' 1 AND 2 MUST BE THE SAME;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2115) 2115 FORMAT(' SUCH WAS NOT THE CASE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1 2116 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2 2117 FORMAT(' VARIABLE ',A4,A4,' HAS ',I8, 1' OBSERVATIONS;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2120) 2120 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,MIN(80,IWIDTH)) 2121 FORMAT(' ',100A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 2190 CONTINUE C C ********************************************* C ** STEP 32-- ** C ** FORM THE VECTOR ISUB(.) ** C ** DEPENDING ON THE TYPE OF CASE ** C ** FOR THE QUALIFIER. ** C ** BRANCH TO THE PROPER CASE. ** C ********************************************* C ISTEPN='32' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NLOCAL=NIRIG1 C IF(ICASEQ.EQ.'FULL')GOTO3210 IF(ICASEQ.EQ.'SUBS')GOTO3220 IF(ICASEQ.EQ.'FOR')GOTO3230 C 3210 CONTINUE DO3215I=1,NLOCAL ISUB(I)=1 3215 CONTINUE NQ=NLOCAL GOTO3250 C 3220 CONTINUE NIOLD=NLOCAL CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4) NQ=NIOLD GOTO3250 C 3230 CONTINUE NIOLD=NLOCAL CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERRO4) NQ=NFOR GOTO3250 C 3250 CONTINUE IF(NQ.GE.MINN2)GOTO3290 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3251) 3251 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3252) 3252 FORMAT(' AFTER THE APPROPRIATE SUBSET ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3253) 3253 FORMAT(' HAS BEEN EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3254)IHRI11,IHRI12 3254 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3255) 3255 FORMAT(' (FOR WHICH A LOWESS FIT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3256) 3256 FORMAT(' IS TO BE FORMED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3257)MINN2 3257 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3258)NQ 3258 FORMAT(' SUCH WAS NOT THE CASE HERE (NQ = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3259) 3259 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH) 3260 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 3290 CONTINUE C C ********************************************** C ** STEP 33-- ** C ** FORM THE SUBSETTED VARIABLES ** C ** Y1(.) ** C ** Y2(.) ** C ** CONTAINING ** C ** THE VERTICAL AXIS VARIABLE ** C ** THE HORIZONTAL AXIS VARIABLE ** C ** RESPECTIVELY. ** C ********************************************** C ISTEPN='33' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C J=0 CCCCC IMAX=NIRIG1 CCCCC IF(NQ.LT.NIRIG1)IMAX=NQ CCCCC DO3300I=1,IMAX DO3300I=1,NLOCAL CCCCC BUG FIX. GO TO END OF LOOP, NOT OUT OF LOOP. SEPTEMBER 1999. CCCCC IF(ISUB(I).EQ.0)GOTO3390 IF(ISUB(I).EQ.0)GOTO3300 J=J+1 C IJ=MAXN*(ICOLR1-1)+I IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ) IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I) IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I) IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I) IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I) IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I) IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I) C CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989 IF(NUMVAR.EQ.1)Y2(J)=J IF(NUMVAR.EQ.1)GOTO3300 C IJ=MAXN*(ICOLR2-1)+I IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ) IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I) IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I) IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I) IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I) IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I) IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I) C 3300 CONTINUE C 3390 CONTINUE NS=J C C ********************************************* C ** STEP 34-- ** C ** CHECK TO MAKE SURE THAT ** C ** AFTER SUBSETTING, ** C ** THE 2 VARIABLES HAVE AT LEAST ** C ** 2 POINTS (THE MINIMUM NEEDED ** C ** TO DO A LOWESS FIT). ** C ********************************************* C ISTEPN='34' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(NS.GE.2)GOTO3490 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3451) 3451 FORMAT('***** ERROR IN DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3452) 3452 FORMAT(' AFTER THE SPECIFIED SUBSETTING ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3453) 3453 FORMAT(' HAS BEEN DONE,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3454) 3454 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3455) 3455 FORMAT(' (FOR WHICH A LOWESS FIT ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3456) 3456 FORMAT(' IS TO BE FORMED)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3457)MINN2 3457 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3458) 3458 FORMAT(' SUCH WAS NOT THE CASE HERE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3459)NS 3459 FORMAT(' (NS = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3460) 3460 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,IWIDTH) 3461 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 3490 CONTINUE C C ****************************************************** C ** STEP 41-- ** C ** CARRY OUT THE LOWESS FIT ** C ****************************************************** C ISTEPN='41' IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PLOW') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CCCCC MARCH 1994. ADD ARGUMENT. CCCCC CALL DPLOW2(Y1,Y2,W,NS,ALOWFR,ALOWDG, IF(ICASAN.EQ.'PLOW')THEN CALL DPLOW2(Y1,Y2,W,NS,ALOWFR,ALOWDG, 1 XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,MAXNXT, 1 IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF, 1 IBUGA3,ISUBRO,IERROR) ELSEIF(ICASAN.EQ.'SLOW')THEN C IHP='PERI' IHP2='OD ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN PERIOD=12.0 ELSE PERIOD=VALUE(ILOCP) ENDIF NP=INT(PERIOD+0.5) C IHP='STLW' IHP2='IDTH' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN NWIDTH=NS/10 ELSE NWIDTH=INT(VALUE(ILOCP)+0.5) ENDIF C IHP='STLS' IHP2='DEG ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN ISDEG=0 ELSE ISDEG=INT(VALUE(ILOCP)+0.5) ENDIF C IHP='STLT' IHP2='DEG ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN ITDEG=0 ELSE ITDEG=INT(VALUE(ILOCP)+0.5) ENDIF C IHP='STLT' IHP2='DEG ' IHWUSE='P' MESSAG='NO' CALL CHECKN(IHP,IHP2,IHWUSE, 1 IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1 ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR) IF(IERROR.EQ.'YES')THEN ROBUST=.TRUE. ELSE ROBUST=.TRUE. IF(INT(VALUE(ILOCP)+0.5).EQ.1)ROBUST=.FALSE. ENDIF C CALL STLEZ(Y1,NS,NP,NWIDTH,ISDEG,ITDEG,ROBUST,NO, 1 W,XTEMP1,XTEMP2,XWORK) DO5010I=1,NS PRED2(I)=XTEMP1(I)+XTEMP2(I) RES2(I)=Y1(I)-PRED2(I) 5010 CONTINUE C C *************************************** C ** STEP 51-- ** C ** WRITE SEASONAL, TREND TO FILE ** C *************************************** C IOUNI1=IST1NU IFILE1=IST1NA ISTAT1=IST1ST IFORM1=IST1FO IACCE1=IST1AC IPROT1=IST1PR ICURS1=IST1CS ISUBN0='FIT3' IERRF1='NO' C IREWI1='ON' CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1, 1 IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR) IF(IERRF1.EQ.'YES')GOTO4200 C DO5110I=1,NS WRITE(IOUNI1,5111)XTEMP1(I),XTEMP2(I) 5111 FORMAT(E15.7,E15.7) 5110 CONTINUE C IF(IPRINT.EQ.'OFF')GOTO5199 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5192) 5192 FORMAT(6X,'SEASONAL AND TREND COMPONENTS WRITTEN TO FILE ', 1 'DPST1F.DAT') CALL DPWRST('XXX','WRIT') 5199 CONTINUE C IENDF1='OFF' IREWI1='ON' CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1, 1 IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR) IF(IERRF1.EQ.'YES')GOTO4200 C ELSE GOTO9000 ENDIF C C *************************************** C ** STEP 52-- ** C ** UPDATE INTERNAL DATAPLOT TABLES ** C *************************************** C 4200 CONTINUE ISTEPN='42' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICOLPR=MAXCP1 ICOLRE=MAXCP2 CCCCC SPETEMBER 1999. BUG FIX FOR SUBSET CCCCC NLEFT=NS NLEFT=NLOCAL IREPU='ON' IRESU='ON' CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLOCAL, 1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,ILOCN,IBUGA3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PLOW')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLOW--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IFOUND,IERROR 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ICASAN,NS,MAXN,MAXNXT,NUMVAR 9014 FORMAT('ICASAN,NS,MAXN,MAXNXT,NUMVAR = ',A4,5I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)NIRIG1,NIRIG2,NLOCAL,NIOLD 9015 FORMAT('NIRIG1,NIRIG2,NLOCAL,NIOLD = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)NLOCAL,NQ,MINN2 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1992 CCCCC IF(NPLOTP.LE.0)GOTO9090 IF(NS.LE.0)GOTO9090 DO9020I=1,NS WRITE(ICOUT,9021)I,Y1(I),Y2(I),PRED2(I),RES2(I),ISUB(I) 9021 FORMAT('I,Y1(I),Y2(I),PRED2(I),RES2(I),ISUB(I) = ', 1I8,4E13.5,I8) CALL DPWRST('XXX','BUG ') 9020 CONTINUE CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT APRIL 1992 CCCCC WRITE(ICOUT,9031)ICOUN1,ICOUN2 C9031 FORMAT('ICOUN1,ICOUN2 = ',2I8) CCCCC CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9041)ALOWFR 9041 FORMAT('ALOWFR = ',E15.7) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPLOW2(Y,X,W,N,ALOWFR,ALOWDG, CCCCC MARCH 1994. ADD ARGUMENT CCCCC SUBROUTINE DPLOW2(Y,X,W,N,ALOWFR, 1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,MAXNXT, 1IREP,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF, 1IBUGA3,ISUBRO,IERROR) C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88/2 C ORIGINAL VERSION--FEBRUARY 1988. C UPDATED --MARCH 1988. ADD LOFCDF C UPDATED --NOVEMBER 1989. RESIDUAL SD C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IREP CHARACTER*4 IBUGA3 CHARACTER*4 ISUBRO CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION X(*) DIMENSION W(*) C DIMENSION XTEMP1(*) DIMENSION XTEMP2(*) DIMENSION XTEMP3(*) DIMENSION XTEMP4(*) DIMENSION XTEMP5(*) DIMENSION XTEMP6(*) DIMENSION XTEMP7(*) C DIMENSION PRED2(*) DIMENSION RES2(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLO' ISUBN2='W2 ' C IERROR='NO' C RESSD=0.0 RESDF=0.0 REPSD=0.0 REPDF=0.0 ALFCDF=(-999.99) C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'LOW2')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLOW2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)N 52 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGA3 53 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') DO55I=1,N WRITE(ICOUT,56)I,Y(I),X(I),W(I) 56 FORMAT('I,Y(I),X(I),W(I) = ',I8,3E15.7) CALL DPWRST('XXX','BUG ') 55 CONTINUE 90 CONTINUE C C ************************************************************** C ** STEP 11-- ** C ** PRINT OUT THE HEADER AND PRELIMINARY INFORMATION ** C ** FOR THE FIT ZZ C ************************************************************** C ISTEPN='11' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C AN=N NN=INT(ALOWFR*AN+0.5) C IF(IPRINT.EQ.'OFF')GOTO1190 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1111) 1111 FORMAT('LOWESS FIT') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1113)N 1113 FORMAT(' SAMPLE SIZE N = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1114)ALOWFR CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989 C1114 FORMAT(' FRACTION (0 TO 1) = ',E15.7) 1114 FORMAT(' FRACTION (0 TO 1) = ',F10.4) WRITE(ICOUT,1115)NN 1115 FORMAT(' NEIGHBORHOOD SIZE = ',I8) CALL DPWRST('XXX','BUG ') 1190 CONTINUE C C ************************************************************** C ** STEP 12-- ** C ** CHECK FOR REPLICATION AND IF EXISTENT ** C ** COMPUTE A (MODEL-FREE) REPLICATION STANDARD DEVIATION. ** C ************************************************************** C ISTEPN='12' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C NUMVAR=1 CALL DPREPS(Y,X,XTEMP2,XTEMP3,XTEMP4,XTEMP5,N,NUMVAR, 1XTEMP6,XTEMP7, 1IREP,REPSS,REPMS,REPSD,REPDF,NUMSET,IBUGA3,IERROR) IREPDF=REPDF+0.5 C IF(IREP.EQ.'NO')GOTO1210 GOTO1220 C 1210 CONTINUE IF(IPRINT.EQ.'OFF')GOTO1219 WRITE(ICOUT,1211) 1211 FORMAT(' NO REPLICATION CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 1219 CONTINUE GOTO1290 C 1220 CONTINUE IF(IPRINT.EQ.'OFF')GOTO1229 WRITE(ICOUT,1221) 1221 FORMAT(' REPLICATION CASE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1222)REPSD 1222 FORMAT(' REPLICATION STANDARD DEVIATION = ',D20.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1223)IREPDF 1223 FORMAT(' REPLICATION DEGREES OF FREEDOM = ',2X,I9) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1224)NUMSET 1224 FORMAT(' NUMBER OF DISTINCT SUBSETS = ',2X,I9) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') 1229 CONTINUE GOTO1290 C 1290 CONTINUE C C ************************************************* C ** STEP 21-- ** C ** CARRY OUT THE LOWESS FIT ** C ************************************************* C ISTEPN='21' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C C CCCCC MARCH 1994. ADD ARGUMENT. CCCCC CALL LOWESS(Y,X,N,ALOWFR, CALL LOWESS(Y,X,N,ALOWFR,ALOWDG, 1XTEMP1,XTEMP2,XTEMP3,XTEMP4,XTEMP5,XTEMP6,XTEMP7,MAXNXT, 1PRED2,RES2,ISUBRO,IBUGA3,IERROR) C IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'LOW2')GOTO2114 WRITE(ICOUT,2111)N 2111 FORMAT('N = ',I8) CALL DPWRST('XXX','BUG ') DO2112I=1,N WRITE(ICOUT,2113)I,Y(I),PRED2(I),RES2(I) 2113 FORMAT('I,Y(I),PRED2(I),RES2(I) = ',I8,3E15.7) CALL DPWRST('XXX','BUG ') 2112 CONTINUE 2114 CONTINUE C CCCCC THE FOLLOWING SECTION WAS COMMENTED OUT NOVEMBER 1989 CCCCC RESSD=SD CCCCC RESDF=NDF CCCCC RESMS=RESSD*RESSD CCCCC RESSS=RESMS*RESDF C CCCCC THE FOLLOWING SECTION WAS INSERTED NOVEMBER 1989 DENOM=N-1 RESSS=0.0 DO2120I=1,N RESSS=RESSS+RES2(I)**2 2120 CONTINUE RESMS=RESSS/DENOM S=0.0 IF(RESMS.GT.0.0)S=SQRT(RESMS) RESDF=DENOM IRESDF=RESDF+0.5 RESSD=S CCCCC RESAAR=SUMAB/AN C IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2') 1WRITE(ICOUT,2121)RESSD,RESDF,RESMS,RESSS 2121 FORMAT('RESSD,RESDF,RESMS,RESSS = ',4E15.7) IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LOW2') 1CALL DPWRST('XXX','BUG ') C C ******************************************************* C ** STEP 31-- ** C ** PRINT OUT PARAMETER ESTIMATES ** C ** AND THEIR STANDARD DEVIATIONS. ** C ** ALSO PRINT OUT THE RESIDUAL STANDARD DEVIATION. ** C ******************************************************* C C ********************************************* C ** STEP 32-- ** C ** PRINT OUT GOODNESS OF FIT INFORMATION ** C ********************************************* C IF(IPRINT.EQ.'OFF')GOTO3219 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') CCCCC THE FOLLOWING SECTION WAS MODIFIED NOVEMBER 1989 WRITE(ICOUT,3211)RESSD 3211 FORMAT(' RESIDUAL STANDARD DEVIATION = ',F20.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3212)IRESDF 3212 FORMAT(' RESIDUAL DEGREES OF FREEDOM (= N-1) = ',2X,I9) CALL DPWRST('XXX','BUG ') 3219 CONTINUE C IF(IREP.EQ.'NO')GOTO3290 IFITDF=IRESDF-IREPDF IF(IPRINT.EQ.'OFF')GOTO3239 CCCCC THE FOLLOWING SECTION WAS MODIFIED NOVEMBER 1989 WRITE(ICOUT,3221)REPSD 3221 FORMAT(' REPLICATION STANDARD DEVIATION = ',F20.10) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3222)IREPDF 3222 FORMAT(' REPLICATION DEGREES OF FREEDOM = ',2X,I9) CALL DPWRST('XXX','BUG ') C IF(IFITDF.GE.1)GOTO3249 WRITE(ICOUT,3231) 3231 FORMAT(' LACK OF FIT F TEST CANNOT BE DONE BECAUSE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3232) 3232 FORMAT(' HAVE ONLY 0 DEGREES OF FREEDOM IN ', 1'NUMERATOR OF F RATIO.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3233) 3233 FORMAT(' THIS HAPPENS WHEN NUMBER OF PARAMETERS ', 1'FITTED') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,3234) 3234 FORMAT(' IS IDENTICAL TO NUMBER OF DISTINCT ', 1'SUBSETS.') CALL DPWRST('XXX','BUG ') 3239 CONTINUE GOTO3290 3249 CONTINUE C FITDF=IFITDF FITSS=RESSS-REPSS FITMS=100000.0 IF(FITDF.GT.0.0)FITMS=FITSS/FITDF FSTAT=100000.0 IF(REPMS.GT.0.0)FSTAT=FITMS/REPMS CALL FCDF(FSTAT,IFITDF,IREPDF,CDF) CDF2=100.0*CDF ALFCDF=CDF C IF(IPRINT.EQ.'OFF')GOTO3259 WRITE(ICOUT,3251)FSTAT,CDF2 C3251 FORMAT(' LACK OF FIT F RATIO = ',F10.4,' = THE ', CALL DPWRST('XXX','BUG ') CCCCC1F8.4,'% POINT OF THE') 3251 FORMAT(' LACK OF FIT F RATIO = ',F12.4,' = THE ', 1F8.4,'% POINT OF THE') WRITE(ICOUT,3252)IFITDF,IREPDF 3252 FORMAT(' F DISTRIBUTION WITH ',I6,' AND ',I6, 1' DEGREES OF FREEDOM') CALL DPWRST('XXX','BUG ') 3259 CONTINUE C 3290 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'LOW2')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLOW2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IERROR 9012 FORMAT('IERROR = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)N,NUMVAR 9013 FORMAT('N,NUMVAR = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)IBUGA3 9017 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') DO9020I=1,N WRITE(ICOUT,9021)I,Y(I),X(I),W(I),PRED2(I),RES2(I) 9021 FORMAT('I,Y(I),X(I),W(I),PRED2(I),RES2(I) = ', 1I8,5E13.6) CALL DPWRST('XXX','BUG ') 9020 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE DPLTES(YTEMP,XTEMP,MAXNXT,ICASAN, 1ICAPSW, 1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR) C C PURPOSE--CARRY OUT LEVENE TEST C (K-SAMPLE HOMOGENEITY OF VARIANCES) C EXAMPLE--LEVENE TEST Y X C REFERENCE--Levene, H. (1960). In Contributions to Probability C and Statistics: Essays in Honor of Harold Hotelling, C I. Olkin et al. eds., Stanford University Press, C pp. 278-292. C --Brown, M. B. and Forsythe, A. B. (1974), Journal C of the American Statistical Association, 69, 364-367. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--97/9 C ORIGINAL VERSION--SEPTEMBER 1997. C UPDATED --AUGIST 1999. BUG FIX IN CALCULATION, C ADD OPTION OF MEDIAN, C MEAN, OR TRIMMED MEAN C UPDATED --JANUARY 2004. SUPPORT FOR HTML, LATEX OUTPUT C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASAN CHARACTER*4 IBUGA2 CHARACTER*4 IBUGA3 CHARACTER*4 IBUGQ CHARACTER*4 IFOUND CHARACTER*4 IERROR CHARACTER*4 ICAPSW C CHARACTER*4 IHWUSE CHARACTER*4 MESSAG CHARACTER*4 ICASEQ C CHARACTER*4 IH11 CHARACTER*4 IH12 CHARACTER*4 IH21 CHARACTER*4 IH22 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C CHARACTER*4 IUSE1 CHARACTER*4 IUSE2 C CCCCC MAY 1995. ADD FOLLOWING DECLARATIONS CHARACTER*4 IH CHARACTER*4 IH2 CHARACTER*4 IHOST1 CHARACTER*4 ISUBN0 C C--------------------------------------------------------------------- C DIMENSION YTEMP(*) DIMENSION XTEMP(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' C DIMENSION YMEDIA(MAXOBV) DIMENSION YMEAN(MAXOBV) DIMENSION T(MAXOBV) DIMENSION TBARIV(MAXOBV) DIMENSION DTAG(MAXOBV) C INCLUDE 'DPCOZZ.INC' EQUIVALENCE(GARBAG(IGARB1),YMEDIA(1)) EQUIVALENCE(GARBAG(IGARB2),T(1)) EQUIVALENCE(GARBAG(IGARB3),TBARIV(1)) EQUIVALENCE(GARBAG(IGARB4),DTAG(1)) EQUIVALENCE(GARBAG(IGARB5),YMEAN(1)) C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCOSU.INC' INCLUDE 'DPCODA.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLT' ISUBN2='ES ' C MAXCP1=MAXCOL+1 MAXCP2=MAXCOL+2 MAXCP3=MAXCOL+3 MAXCP4=MAXCOL+4 MAXCP5=MAXCOL+5 MAXCP6=MAXCOL+6 C IFOUND='NO' IERROR='NO' C N1=(-999) N2=(-999) C NS1=(-999) NS2=(-999) C IUSE1='-999' IUSE2='-999' C ILOCV=(-999) C VALUE1=(-999.0) VALUE2=(-999.0) C ICOL1=(-999) ICOL2=(-999) C MINN2=2 C IFOUND='YES' C NLEFT=0 C ICASEQ='UNKN' C C ************************************** C ** TREAT THE LEVENE TEST CASE ** C ************************************** C IF(IBUGA2.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IBUGA2,IBUGA3 52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IBUGQ 53 FORMAT('IBUGQ = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)MAXNXT 55 FORMAT('MAXNXT = ',I8) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************************* C ** STEP 2-- ** C ** CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. ** C ******************************************************* C ISTEPN='2' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C MINNA=2 MAXNA=100 CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2, 1IERROR) IF(IERROR.EQ.'YES')GOTO9000 C C **************************************** C ** STEP 11-- ** C ** CHECK THE VALIDITY OF ARGUMENT 1 ** C ** (THIS SHULD BE A VARIABLE.) ** C **************************************** C ISTEPN='11' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IH11=IHARG(1) IH12=IHARG2(1) IHWUSE='V' MESSAG='YES' CALL CHECKN(IH11,IH12,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1141) 1141 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1142) 1142 FORMAT(' FOR LEVENE TEST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1145) 1145 FORMAT(' BOTH ARGUMENTS MUST BE A VARIABLE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1146) 1146 FORMAT(' (AS OPPOSED TO A PARAMETER OR FUNCTION).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1147) 1147 FORMAT(' ARGUMENT 1 WAS NOT A VARIABLE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1148) 1148 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH) 1150 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C IUSE1=IUSE(ILOCV) ICOL1=IVALUE(ILOCV) N1=IN(ILOCV) 1190 CONTINUE C C ******************************************************** C ** STEP 12-- ** C ** IF ARGUMENT 1 IS A VARIABLE, ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) ** C ** FOR ARGUMENT 1 IS 2 OR MORE. ** C ******************************************************** C ISTEPN='12' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IUSE1.NE.'V')GOTO1290 IF(N1.GE.MINN2)GOTO1290 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1212) 1212 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1213) 1213 FORMAT(' (FOR WHICH LEVENE TEST ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1214) 1214 FORMAT(' WAS TO HAVE BEEN CARRIED OUT)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215)MINN2 1215 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT(' SUCH WAS NOT THE CASE HERE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217)IH11,IH12 1217 FORMAT(' FOR VARIABLE ',A4,A4,' WHICH HAD') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1218)N1 1218 FORMAT(' NUMBER OF OBSERVATIONS = ',I8,';') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1219) 1219 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH) 1220 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 1290 CONTINUE C C **************************************** C ** STEP 21-- ** C ** CHECK THE VALIDITY OF ARGUMENT 2 ** C ** (THIS SHOULD ALSO BE A VARIABLE) ** C **************************************** C ISTEPN='21' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IH21=IHARG(2) IH22=IHARG2(2) IHWUSE='V' MESSAG='YES' CALL CHECKN(IH21,IH22,IHWUSE, 1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM, 1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR) C IF(IERROR.EQ.'YES')THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2141) 2141 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2142) 2142 FORMAT(' FOR LEVENE TEST,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2145) 2145 FORMAT(' BOTH ARGUMENTS MUST BE A VARIABLE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2146) 2146 FORMAT(' (AS OPPOSED TO A PARAMETER OR FUNCTION).') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2147) 2147 FORMAT(' ARGUMENT 2 WAS NOT A VARIABLE HERE.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2148) 2148 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH) 2150 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 ENDIF C IUSE2=IUSE(ILOCV) ICOL2=IVALUE(ILOCV) N2=IN(ILOCV) 2190 CONTINUE C C ******************************************************** C ** STEP 22-- ** C ** IF ARGUMENT 2 IS A VARIABLE, ** C ** CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2) ** C ** FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1. ** C ******************************************************** C ISTEPN='22' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IUSE2.NE.'V')GOTO2290 IF(N2.EQ.N1)GOTO2290 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2211) 2211 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2212) 2212 FORMAT(' THE INPUT NUMBER OF OBSERVATIONS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2213) 2213 FORMAT(' (FOR VARIABLE 2 OF LEVENE TEST ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2214) 2214 FORMAT(' MUST BE THE SAME AS VARIABLE 1') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2215) 2215 FORMAT(' SUCH WAS NOT THE CASE HERE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2216)N1,N2 2216 FORMAT(' N1 = ',I8,' N2 = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,2219) 2219 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH) 2220 FORMAT(80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 2290 CONTINUE C C ***************************************** C ** STEP 40-- ** C ** CHECK TO SEE THE TYPE CASE-- ** C ** 1) UNQUALIFIED (THAT IS, FULL); ** C ** 2) SUBSET/EXCEPT; OR ** C ** 3) FOR. ** C ***************************************** C ISTEPN='40' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ICASEQ='FULL' ILOCQ=NUMARG+1 IF(NUMARG.LT.1)GOTO4090 DO4000J=1,NUMARG J1=J IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET ') GOTO4010 IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT ') GOTO4010 IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.' ') GOTO4020 4000 CONTINUE GOTO4090 4010 CONTINUE ICASEQ='SUBS' ILOCQ=J1 GOTO4090 4020 CONTINUE ICASEQ='FOR' ILOCQ=J1 GOTO4090 4090 CONTINUE IF(IBUGA2.EQ.'OFF')GOTO4095 WRITE(ICOUT,4091)NUMARG,ILOCQ 4091 FORMAT('NUMARG,ILOCQ = ',2I8) CALL DPWRST('XXX','BUG ') 4095 CONTINUE C C *********************************************** C ** STEP 41-- ** C ** TEMPORARILY FORM THE VARIABLE Y(.) ** C ** WHICH WILL HOLD THE DATA FROM SAMPLE 1. ** C ** FORM THIS VARIABLE BY ** C ** BRANCHING TO THE APPROPRIATE SUBCASE ** C ** (FULL, SUBSET, OR FOR). ** C *********************************************** C IF(IUSE1.NE.'V')GOTO4190 C ISTEPN='41' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO4110 IF(ICASEQ.EQ.'SUBS')GOTO4120 IF(ICASEQ.EQ.'FOR')GOTO4130 C 4110 CONTINUE DO4115I=1,N1 ISUB(I)=1 4115 CONTINUE NQ=N1 GOTO4150 C 4120 CONTINUE NIOLD=N1 CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO4150 C 4130 CONTINUE NIOLD=N1 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO4150 C 4150 CONTINUE IF(NQ.GE.MINN2)GOTO4160 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4151) 4151 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4152) 4152 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4153)IH11,IH12 4153 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4154) 4154 FORMAT(' (FOR WHICH LEVENE TEST ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4155) 4155 FORMAT(' IS TO BE CARRIED OUT)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4156)MINN2 4156 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4157)NQ 4157 FORMAT(' SUCH WAS NOT THE CASE HERE. (N = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4158) 4158 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH) 4159 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 4160 CONTINUE J=0 IMAX=N1 IF(NQ.LT.N1)IMAX=NQ DO4170I=1,IMAX IF(ISUB(I).EQ.0)GOTO4170 J=J+1 C IJ=MAXN*(ICOL1-1)+I IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ) IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I) IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I) IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I) IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I) IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I) IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I) C 4170 CONTINUE NS1=J C 4190 CONTINUE C C *********************************************** C ** STEP 42-- ** C ** TEMPORARILY FORM THE VARIABLE X(.) ** C ** WHICH WILL HOLD THE DATAN FROM SAMPLE 2. ** C ** FORM THIS VARIABLE BY ** C ** BRANCHING TO THE APPROPRIATE SUBCASE ** C ** (FULL, SUBSET, OR FOR). ** C *********************************************** C IF(IUSE2.NE.'V')GOTO4290 C ISTEPN='42' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ICASEQ.EQ.'FULL')GOTO4210 IF(ICASEQ.EQ.'SUBS')GOTO4220 IF(ICASEQ.EQ.'FOR')GOTO4230 C 4210 CONTINUE DO4215I=1,N2 ISUB(I)=1 4215 CONTINUE NQ=N2 GOTO4250 C 4220 CONTINUE NIOLD=N2 CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR) NQ=NIOLD GOTO4250 C 4230 CONTINUE NIOLD=N2 CALL DPFOR(NIOLD,NFOR,IROW1,IROWN, 1NLOCAL,ILOCS,NS,IBUGQ,IERROR) NQ=NFOR GOTO4250 C 4250 CONTINUE IF(NQ.GE.MINN2)GOTO4260 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4251) 4251 FORMAT('***** ERROR IN DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4252) 4252 FORMAT(' AFTER THE APPROPRIATE SUBSET HAS BEEN ', 1'EXTRACTED,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4253)IH21,IH22 4253 FORMAT(' THE NUMBER OF OBSERVATIONS REMAINING', 1'FROM VARIABLE ',A4,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4254) 4254 FORMAT(' (FOR WHICH LEVENE TEST ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4255) 4255 FORMAT(' IS TO BE CARRIED OUT)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4256)MINN2 4256 FORMAT(' MUST BE ',I8,' OR LARGER;') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4257)NQ 4257 FORMAT(' SUCH WAS NOT THE CASE HERE. (N = ',I8,')') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,4258) 4258 FORMAT(' THE ENTERED COMMAND LINE WAS AS FOLLOWS--') CALL DPWRST('XXX','BUG ') IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH) 4259 FORMAT(' ',80A1) IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ') IERROR='YES' GOTO9000 C 4260 CONTINUE J=0 IMAX=N2 IF(NQ.LT.N2)IMAX=NQ DO4270I=1,IMAX IF(ISUB(I).EQ.0)GOTO4270 J=J+1 C IJ=MAXN*(ICOL2-1)+I IF(ICOL2.LE.MAXCOL)X(J)=V(IJ) IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I) IF(ICOL2.EQ.MAXCP2)X(J)=RES(I) IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I) IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I) IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I) IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I) C 4270 CONTINUE NS2=J C 4290 CONTINUE C C ********************************* C ** STEP 52-- ** C ** DO LEVENE TEST ** C ********************************* C ISTEPN='52' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IBUGA2.EQ.'OFF')GOTO5290 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5211) 5211 FORMAT('***** FROM DPLTES, AS WE ARE ABOUT TO CALL DPLTE2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8) CALL DPWRST('XXX','BUG ') DO5215I=1,NS1 WRITE(ICOUT,5216)I,Y(I) 5216 FORMAT('I,Y(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 5215 CONTINUE DO5217I=1,NS1 WRITE(ICOUT,5218)I,Y(I) 5218 FORMAT('I,Y(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 5217 CONTINUE CCCCC IBUGA3='ABCD' WRITE(ICOUT,5231)IBUGA3 5231 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','BUG ') 5290 CONTINUE C CALL DPLTE2(Y,X,NS1,ICASAN,MAXOBV, 1YTEMP,XTEMP,YMEAN,YMEDIA,T,TBARIV,DTAG,MAXNXT, 1ICAPSW,ICAPTY, 1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999, 1IBUGA3,IERROR) C C *************************************** C ** STEP 61-- ** C ** UPDATE INTERNAL DATAPLOT TABLES ** C *************************************** C ISTEPN='61' IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C ISUBN0='DPLT' C IH='STAT' IH2='VAL ' VALUE0=STATVA CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='STAT' IH2='CDF ' VALUE0=STATCD CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF0 ' VALUE0=CUT0 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF50' VALUE0=CUT50 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF75' VALUE0=CUT75 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF90' VALUE0=CUT90 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF95' VALUE0=CUT95 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='FF99' VALUE0=CUT99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C IH='CUTO' IH2='F999' VALUE0=CUT99 CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0, 1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM, 1IANS,IWIDTH,IBUGA3,IERROR) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGA2.EQ.'OFF')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPLTES--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IBUGA2,IBUGA3 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IBUGQ 9013 FORMAT('IBUGQ = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NLEFT,NS 9014 FORMAT('NLEFT,NS = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)ICASEQ 9015 FORMAT('ICASEQ = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IFOUND,IERROR 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPLTE2(Y,TAG,N,ICASAN,MAXOBV, 1YTEMP,XTEMP,YMEAN,YMEDIA,T,TBARIV,DTAG,MAXNXT, 1ICAPSW,ICAPTY, 1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999, 1IBUGA3,IERROR) C C PURPOSE--THIS ROUTINE CARRIES OUT LEVENE'S TEST C (K-SAMPLE HOMOSCEDASTICITY TEST) C EXAMPLE--LEVENE'S TEST Y TAG C REFERENCE--Levene, H. (1960). In Contributions to Probability C and Statistics: Essays in Honor of Harold Hotelling, C I. Olkin et al. eds., Stanford University Press, C pp. 278-292. C --Brown, M. B. and Forsythe, A. B. (1974), Journal C of the American Statistical Association, 69, 364-367. C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C Gaithersburg, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--97/9 C ORIGINAL VERSION--SEPTEMBER 1997. C UPDATED --AUGUST 1999. BUG FIX IN CALCULATION, C SUPPORT FOR MEDIAN, MEAN, C OR TRIMMED MEAN VERSION C UPDATED --JANUARY 2004. SUPPORT FOR HTML, LATEX OUTPUT C UPDATED --JULY 2005. ADD SOME TEXT TO THE OUTPUT C TO MAKE IT MORE EXPLICIT C WHICH VARIANT OF THE TEST C IS BEING USED. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ICASAN CHARACTER*4 IBUGA3 CHARACTER*4 IERROR CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY C CHARACTER*4 IWRITE CHARACTER*4 IBASLC C CHARACTER*6 ICONC1 CHARACTER*6 ICONC2 CHARACTER*6 ICONC3 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C DOUBLE PRECISION DSUM1 C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION TAG(*) DIMENSION DTAG(*) DIMENSION YTEMP(*) DIMENSION XTEMP(*) DIMENSION YMEDIA(*) DIMENSION YMEAN(*) DIMENSION T(*) DIMENSION TBARIV(*) C C--------------------------------------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN1='DPLT' ISUBN2='E2 ' C IERROR='NO' C IF(IBUGA3.EQ.'OFF')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,51) 51 FORMAT('**** AT THE BEGINNING OF DPLTE2--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,55)N 55 FORMAT('N = ',I8) CALL DPWRST('XXX','WRIT') DO56I=1,N WRITE(ICOUT,57)I,Y(I) 57 FORMAT('I,Y(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 56 CONTINUE WRITE(ICOUT,65)N 65 FORMAT('N = ',I8) CALL DPWRST('XXX','WRIT') DO66I=1,N WRITE(ICOUT,67)I,TAG(I) 67 FORMAT('I,TAG(I) = ',I8,E15.7) CALL DPWRST('XXX','WRIT') 66 CONTINUE 90 CONTINUE C C ******************************************** C ** STEP 11-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C ISTEPN='11' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(N.GE.1)GOTO1119 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN DPLTE2--THE NUMBER OF OBSERVATIONS ', 1'FOR VARIABLE 1 IS NON-POSITIVE') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1112)N 1112 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 1119 CONTINUE C IF(N.EQ.1)GOTO1120 GOTO1129 1120 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1121) 1121 FORMAT('***** NOTE FROM DPLTE2--VARIABLE 1 ', 1'HAS ONLY 1 ELEMENT') CALL DPWRST('XXX','WRIT') GOTO9000 1129 CONTINUE C HOLD=Y(1) DO1135I=2,N IF(Y(I).NE.HOLD)GOTO1139 1135 CONTINUE 1130 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1131)HOLD 1131 FORMAT('***** NOTE FROM DPLTE2--VARIABLE 1 ', 1'HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 1139 CONTINUE C IF(N.GE.1)GOTO1219 WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1211) 1211 FORMAT('***** ERROR IN DPLTE2--THE NUMBER OF OBSERVATIONS ', 1'FOR VARIABLE 2 IS NON-POSITIVE') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1212)N 1212 FORMAT('SAMPLE SIZE = ',I8) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 1219 CONTINUE C IF(N.EQ.1)GOTO1220 GOTO1229 1220 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1221) 1221 FORMAT('***** NOTE FROM DPLTE2--VARIABLE 2 ', 1'HAS ONLY 1 ELEMENT') CALL DPWRST('XXX','WRIT') GOTO9000 1229 CONTINUE C HOLD=TAG(1) DO1235I=2,N IF(TAG(I).NE.HOLD)GOTO1239 1235 CONTINUE 1230 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1231)HOLD 1231 FORMAT('***** NOTE FROM DPLTE2--VARIABLE 2 ', 1'HAS ALL ELEMENTS = ',E15.7) CALL DPWRST('XXX','WRIT') GOTO9000 1239 CONTINUE C 1290 CONTINUE C C ****************************** C ** STEP 41-- ** C ** CARRY OUT CALCULATIONS ** C ** FOR LEVENE'S TEST ** C ****************************** C 4100 CONTINUE C ISTEPN='41' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IWRITE='OFF' CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR) C DO4200IDIS=1,NUMDIS J=0 DO4300I=1,N IF(TAG(I).EQ.DTAG(IDIS))THEN J=J+1 YTEMP(J)=Y(I) ENDIF 4300 CONTINUE IF(ICASAN.EQ.'LMED')THEN CALL MEDIAN(YTEMP,J,IWRITE,XTEMP,MAXNXT,YMEDIA(IDIS), 1 IBUGA3,IERROR) ELSEIF(ICASAN.EQ.'LMEA')THEN CALL MEAN(YTEMP,J,IWRITE,YMEDIA(IDIS),IBUGA3,IERROR) ELSEIF(ICASAN.EQ.'LTRI')THEN PROP1=10.0 PROP2=10.0 IUPPER=MAXOBV CALL TRIMME(YTEMP,J,PROP1,PROP2,IWRITE,XTEMP,IUPPER, 1 YMEDIA(IDIS),IBUGA3,IERROR) ELSE CALL MEDIAN(YTEMP,J,IWRITE,XTEMP,MAXNXT,YMEDIA(IDIS), 1 IBUGA3,IERROR) ENDIF DO4400I=1,N IF(TAG(I).EQ.DTAG(IDIS))T(I)=ABS(Y(I)-YMEDIA(IDIS)) 4400 CONTINUE 4200 CONTINUE C CCCCC BUG FIX IN FOLLOWING LINE. AUGUST 1999. CCCCC CALL MEAN(Y,N,IWRITE,TBAR,IBUGA3,IERROR) CALL MEAN(T,N,IWRITE,TBAR,IBUGA3,IERROR) C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,4901)TBAR 4901 FORMAT('TBAR = ',G15.7) CALL DPWRST('XXX','BUG') DO4905I=1,N WRITE(ICOUT,4906)I,TAG(I),DTAG(I),Y(I),T(I) 4906 FORMAT('I,TAG(I),DTAG(I),Y(I),T(I)=',I8,4G15.7) CALL DPWRST('XXX','BUG') 4905 CONTINUE ENDIF C DO5200IDIS=1,NUMDIS J=0 DO5300I=1,N IF(TAG(I).EQ.DTAG(IDIS))THEN J=J+1 CCCCC BUG FIS: AUGUST 1999 CCCCC YTEMP(J)=Y(I) YTEMP(J)=T(I) ENDIF 5300 CONTINUE CALL MEAN(YTEMP,J,IWRITE,YMEAN(IDIS),IBUGA3,IERROR) DO5400I=1,N IF(TAG(I).EQ.DTAG(IDIS))TBARIV(I)=YMEAN(IDIS) 5400 CONTINUE 5200 CONTINUE C IF(IBUGA3.EQ.'ON')THEN DO5205I=1,N WRITE(ICOUT,5206)I,TAG(I),DTAG(I),TBARIV(I) 5206 FORMAT('I,TAG(I),DTAG(I),TBARIV(I)=',I8,3G15.7) CALL DPWRST('XXX','BUG') 5205 CONTINUE ENDIF C DSUM1=0.D0 DO6100I=1,N DSUM1=DSUM1 + (TBARIV(I)-TBAR)**2 6100 CONTINUE SSQ=SNGL(DSUM1) NUMDF=NUMDIS-1 ANUMMS=SSQ/REAL(NUMDF) C DSUM1=0.D0 DO6200I=1,N DSUM1=DSUM1 + (T(I)-TBARIV(I))**2 6200 CONTINUE SSQ=SNGL(DSUM1) IDENDF=N-NUMDIS DENMS=SSQ/REAL(IDENDF) C IF(IBUGA3.EQ.'ON')THEN WRITE(ICOUT,6201)ANUMMS,DENMS 6201 FORMAT('ANUMMS,DENMS=',2G15.7) CALL DPWRST('XXX','BUG') ENDIF C STATVA=ANUMMS/DENMS CALL FCDF(STATVA,NUMDF,IDENDF,STATCD) C KM1=NUMDIS-1 NMK=N-NUMDIS C CUT0=0.0 CALL FPPF(.50,KM1,NMK,CUT50) CALL FPPF(.75,KM1,NMK,CUT75) CALL FPPF(.90,KM1,NMK,CUT90) CALL FPPF(.95,KM1,NMK,CUT95) CALL FPPF(.99,KM1,NMK,CUT99) CALL FPPF(.999,KM1,NMK,CUT999) C ICONC1='REJECT' ICONC2='REJECT' ICONC3='REJECT' C IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC2='ACCEPT' C C ****************************** C ** STEP 42-- ** C ** WRITE OUT EVERYTHING ** C ** FOR LEVENE'S TEST ** C ****************************** C ISTEPN='42' IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(IPRINT.EQ.'ON')THEN IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN C C STEP 1: WRITE HEADER C WRITE(ICOUT,5001) 5001 FORMAT('') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5002) 5002 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5003) 5003 FORMAT('LEVENE F-TEST FOR SHIFT IN VARIATION
') CALL DPWRST('XXX','WRIT') IF(ICASAN.EQ.'LMEA')THEN WRITE(ICOUT,5104) 5104 FORMAT('(CASE: TEST BASED ON MEANS)
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) 5004 FORMAT('(ASSUMPTION: NORMALITY)') CALL DPWRST('XXX','WRIT') ELSEIF(ICASAN.EQ.'LMED')THEN WRITE(ICOUT,5204) 5204 FORMAT('(CASE: TEST BASED ON MEDIANS)') CALL DPWRST('XXX','WRIT') ELSEIF(ICASAN.EQ.'LTRI')THEN WRITE(ICOUT,5304) 5304 FORMAT('(CASE: TEST BASED ON TRIMMED MEANS)') CALL DPWRST('XXX','WRIT') ENDIF WRITE(ICOUT,5005) 5005 FORMAT('


') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START LIST C WRITE(ICOUT,5006) 5006 FORMAT('
    ') CALL DPWRST('XXX','WRIT') C C STEP 2A: LIST ITEM 1 C 5007 FORMAT('
  1. Statistics:') 5009 FORMAT('

    ') 5011 FORMAT(' ') 5021 FORMAT(' ') 5023 FORMAT(' ') 5026 FORMAT(' ') 5051 FORMAT(' ',G15.7) 5052 FORMAT('  ') WRITE(ICOUT,5007) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5009) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5011) CALL DPWRST('XXX','WRIT') C 5025 FORMAT(' Number of Observations:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5025) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5029)N CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5041 FORMAT(' Number of Groups:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5041) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)NUMDIS CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5045 FORMAT(' Levene F Test Statistic:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5045) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)STATVA CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5052) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5052) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5091) 5091 FORMAT('
    ') 5027 FORMAT(' ') 5029 FORMAT(' ',I8) 5028 FORMAT('
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5009) CALL DPWRST('XXX','WRIT') C C STEP 2B: LIST ITEM 2 C WRITE(ICOUT,5066) 5066 FORMAT('

  2. Percent Points of the Reference ', 1 'Distribution
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5067) 5067 FORMAT(' for the Grubbs Test Statistic:') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5009) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5011) CALL DPWRST('XXX','WRIT') C 5071 FORMAT(' 0 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5071) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT0 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5072 FORMAT(' 50 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5072) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT50 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5073 FORMAT(' 75 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5073) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT75 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5074 FORMAT(' 90 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5074) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT90 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5075 FORMAT(' 95 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5075) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT95 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5076 FORMAT(' 99 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5076) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT99 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5077 FORMAT(' 99.9 Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5077) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)CUT999 CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5052) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5052) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C 5078 FORMAT(' ',G15.7,' Percent Point:') WRITE(ICOUT,5021) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5023) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5078)100.0*STATCD CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5026) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5051)STATVA CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5027) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5028) CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5091) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5009) CALL DPWRST('XXX','WRIT') C C STEP 2C: LIST ITEM 3 C WRITE(ICOUT,5081) 5081 FORMAT('
  3. Conclusion (at the 5% level):') CALL DPWRST('XXX','WRIT') C WRITE(ICOUT,5009) CALL DPWRST('XXX','WRIT') IF(STATVA.LE.CUT95)THEN WRITE(ICOUT,5087) 5087 FORMAT(' There is no shift in variation.
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5187) 5187 FORMAT(' Thus the groups are homogeneous with ', 1 'respect to variation.') CALL DPWRST('XXX','WRIT') ELSE WRITE(ICOUT,5088) 5088 FORMAT(' There is a shift in variation.
    ') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5188) 5188 FORMAT(' Thus the groups are not homogeneous with ', 1 'respect to variation.') CALL DPWRST('XXX','WRIT') ENDIF CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5093) 5093 FORMAT('
') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5095) 5095 FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8000   FORMAT('{',A1,'bf LEVENE F-TEST FOR SHIFT IN VARIATION}',
     1         2X,A1,A1)
 8001   FORMAT('{',A1,'bf (Assumption: Normality}')
 8401   FORMAT('{',A1,'bf (Case: Test Based On Means}')
 8402   FORMAT('{',A1,'bf (Case: Test Based On Medians}')
 8403   FORMAT('{',A1,'bf (Case: Test Based On Trimmed Means}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8000)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'LMEA')THEN
          WRITE(ICOUT,8401)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8001)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASAN.EQ.'LMED')THEN
          WRITE(ICOUT,8402)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASAN.EQ.'LTRI')THEN
          WRITE(ICOUT,8403)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(11X,A1,'newline')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Percent Points of the Reference ',
     1         'Distribution for Levene Test Statistic:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Number of Groups: & ',I8,2X,A1,A1)
 8036   FORMAT(11X,'Levene F-Test Statistic: & ',G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8042   FORMAT(11X,'There is no shift in variation.',2X,A1,A1)
 8043   FORMAT(11X,'Thus the groups are homogeneous with respect ',
     1        'to variation.',2X,A1,A1)
 8142   FORMAT(11X,'There is a shift in variation.',2X,A1,A1)
 8143   FORMAT(11X,'Thus the groups are not homogeneous with ',
     1        'respect to variation.',2X,A1,A1)
 8044   FORMAT(11X,'0      Percent Point: & ',G15.7,2X,A1,A1)
 8045   FORMAT(11X,'50     Percent Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'90     Percent Point: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'95     Percent Point: & ',G15.7,2X,A1,A1)
 8048   FORMAT(11X,'99     Percent Point: & ',G15.7,2X,A1,A1)
 8049   FORMAT(11X,'99.9   Percent Point: & ',G15.7,2X,A1,A1)
 8050   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)NUMDIS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)CUT999,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)100.0*STATCD,STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8043)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8042)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8043)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(A1,'end{enumerate}')
 8052   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7211)
 7211   FORMAT('              LEVENE F-TEST FOR SHIFT IN VARIATION')
        CALL DPWRST('XXX','WRIT')
        IF(ICASAN.EQ.'LMED')THEN
          WRITE(ICOUT,7216)
 7216     FORMAT('               (CASE: TEST BASED ON MEDIANS)')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASAN.EQ.'LMEA')THEN
          WRITE(ICOUT,7217)
 7217     FORMAT('                (CASE: TEST BASED ON MEANS)')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7212)
 7212     FORMAT('                (ASSUMPTION: NORMALITY)')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASAN.EQ.'LTRI')THEN
          WRITE(ICOUT,7218)
 7218     FORMAT('             (CASE: TEST BASED ON TRIMMED MEANS)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7222)
 7222   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)N
 7224   FORMAT(6X,'NUMBER OF OBSERVATIONS    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7226)NUMDIS
 7226   FORMAT(6X,'NUMBER OF GROUPS          = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7228)STATVA
 7228   FORMAT(6X,'LEVENE F TEST STATISTIC   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 7240   FORMAT('2. PERCENT POINTS OF THE REFERENCE DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR LEVENE TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7345)CUT0
 7345   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7346)CUT50
 7346   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7347)CUT75
 7347   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7348)CUT90
 7348   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7349)CUT95
 7349   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7350)CUT99
 7350   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7351)CUT999
 7351   FORMAT(6X,'99.9       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7247)100.*STATCD,STATVA
 7247   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7261)
 7261   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7262)
 7262     FORMAT(6X,'THERE IS NO SHIFT IN VARIATION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7263)
 7263     FORMAT(6X,'THUS THE GROUPS ARE HOMOGENEOUS WITH RESPECT ',
     1           'TO VARIATION.')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7272)
 7272     FORMAT(6X,'THERE IS A SHIFT IN VARIATION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,7273)
 7273     FORMAT(6X,'THUS THE GROUPS ARE NOT HOMOGENEOUS WITH ',
     1           'RESPECT TO VARIATION.')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N
 9025 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N
      WRITE(ICOUT,9027)I,TAG(I)
 9027 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLUJA(XTEMP1,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT LJUNG BOX TEST FOR RANDOMNESS
C     EXAMPLE--LJUNG BOX TEST Y
C     REFERENCE--PETER BROCKWELL AND RICHARD DAVIS (2002).
C                "INTRODUCTION TO TIME SERIES AND FORECASTING",
C                SECOND EDITION, SPRINGER.
C     TEST--  Q=N*(N+2_SUM[J=1 TO H][RHOHAT**2/(N-J)
C             REJECT RANDOMNESS IF Q > CHI-SQUARE PPF(H,1-ALPHA)
C             WHERE RHOHAT IS THE SAMPLE AUTOCORRELATION
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/3
C     ORIGINAL VERSION--FEBRUARY  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION YTEMP1(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),YTEMP1(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPLU'
      ISUBN2='JA  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************************
C               **  TREAT THE LJUNG-BOX        TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'LUJA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPLUJA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPLUJA--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE LJUNG-BOX TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      THE ARGUMENT MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPLUJA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH THE LJUNG-BOX TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPLUJA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH THE LJUNG-BOX TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************
C               **  STEP 52--                    **
C               **  DO THE LJUNG-BOX TEST        **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPLUJA, AS WE ARE ABOUT TO CALL DPLUJ2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
C               *****************************************************
C               **  STEP 53--                                      **
C               **  DETERMINE IF THE ANALYST                       **
C               **  HAS SPECIFIED THE NUMBER OF LAGS DESIRED       **
C               **  FOR THE LJUNG-BOX TEST.                        **
C               **  THE LAG SETTING IS DONE BY SEARCHING THE       **
C               **  INTERNAL TABLE FOR THE PARAMETER NAMES         **
C               **  LAGS, LAG, OR NUMLAG                           **
C               **  (WITH THE SEARCH CONDUCTED IN THAT ORDER       **
C               **  AND WITH THE FIRST FIND TERMINATING            **
C               **  THE SEARCH.)                                   **
C               **  IF FOUND, USE THE SPECIFIED VALUE              **
C               **  (WHICH MUST BE BETWEEN 1 AND 1000, INCLUSIVE); **
C               **  IF NOT FOUND, USE THE DEFAULT VALUE            **
C               **  (USUALLY NS/4) WHICH WILL BE DEFINED           **
C               **  IN THE SUBROUTINE DPCOR2.                      **
C               *****************************************************
C
      ISTEPN='53'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'LUJA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLAG=0
C
      IH='LAGS'
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO5790
C
      IH='LAG '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO5790
C
      IH='NUML'
      IH2='AG  '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO5790
C
 5790 CONTINUE
C
      CALL DPLUJ2(Y,NS1,
     1XTEMP1,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,
     1YTEMP1,NUMLAG,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPLU'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
 
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'LUJA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLUJA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPLUJ2(Y,N,
     1XTEMP,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,
     1YTEMP1,NUMLAG,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT THE LJUNG-BOX TEST
C              FOR RANDOMNESS.
C     EXAMPLE--LJUNG-BOX TEST Y
C     REFERENCE--PETER BROCKWELL AND RICHARD DAVIS (2002).
C                "INTRODUCTION TO TIME SERIES AND FORECASTING",
C                SECOND EDITION, SPRINGER.
C     TEST--  Q=N*(N+2_SUM[J=1 TO H][RHOHAT**2/(N-J)
C             REJECT RANDOMNESS IF Q > CHI-SQUARE PPF(H,1-ALPHA)
C             WHERE RHOHAT IS THE SAMPLE AUTOCORRELATION
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/3
C     ORIGINAL VERSION--FEBRUARY  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*6 ICONC4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP1(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPLU'
      ISUBN2='J2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'LUJ2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPLUJ2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN LJUNG-BOX RANDOMNESS TEST.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      AT LEAST SIX OBSERVATIONS REQUIRED.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM LJUNG-BOX RANDOMNESS TEST--VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               *******************************
C               **  STEP 2--                 **
C               **  IF NECESSARY,            **
C               **  COMPUTE THE MAXIMUM LAG  **
C               *******************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXLAG=MAXNXT
      IF(NUMLAG.GE.1)KMAX=NUMLAG
      IF(NUMLAG.LE.0)KMAX=N/4
      IF(NUMLAG.LE.0.AND.N.LE.32)KMAX=N/2
      IF(NUMLAG.LE.0.AND.N.LE.16)KMAX=N
      IF(KMAX.GT.MAXLAG)KMAX=MAXLAG
      NM1=N-1
      IF(KMAX.GT.NM1)KMAX=NM1
      IF(N.LE.16)THEN
         NM2=N-2
         IF(KMAX.GT.NM2)KMAX=NM2
      ENDIF
      KMAXM1=KMAX-1
      AKMAXM=KMAXM1
C
C               ******************************************************
C               **  STEP 4.1--                                      **
C               **  COMPUTE THE AUTOCORRELATIONS FOR THE Y  DATA    **
C               **  DO SO IN 3 STEPS--                              **
C               **     1) COMPUTE THE SAMPLE MEAN;                  **
C               **     2) COMPUTE THE SAMPLE VARIANCE;              **
C               **     3) COMPUTE THE AUTOCORRELATIONS;             **
C               **  REFERENCE--JENKINS AND WATTS, PAGE 382 (9.3.1)  **
C               ******************************************************
C
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'LUJ2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     COMPUTE AUTOCORRELATIONS FOR N <= 20
C
      IF(N.LE.16)THEN
        AN=N
C
        DO4110K=1,KMAXM1
          NMK=N-K
          ANMK=NMK
          SUM1=0.0
          SUM2=0.0
          DO4120I=1,NMK
            J=I+K
            SUM1=SUM1+Y(I)
            SUM2=SUM2+Y(J)
 4120     CONTINUE
          Y1BAR=SUM1/ANMK
          Y2BAR=SUM2/ANMK
C
          SUM1=0.0
          SUM2=0.0
          DO4130I=1,NMK
            J=I+K
            SUM1=SUM1+(Y(I)-Y1BAR)**2
            SUM2=SUM2+(Y(J)-Y2BAR)**2
 4130     CONTINUE
          SSQ1=SUM1
          SSQ2=SUM2
C
          SUM1=0.0
          DO4140I=1,NMK
            J=I+K
            SUM1=SUM1+(Y(I)-Y1BAR)*(Y(J)-Y2BAR)
 4140     CONTINUE
          ANUM=SUM1
C
          SQRT1=0.0
          IF(SSQ1.GT.0.0)SQRT1=SQRT(SSQ1)
          SQRT2=0.0
          IF(SSQ2.GT.0.0)SQRT2=SQRT(SSQ2)
          DENOM=SQRT1*SQRT2
          AC=0.0
          IF(DENOM.GT.0.0)AC=ANUM/DENOM
          YTEMP1(K)=AC
 4110   CONTINUE
      ELSE
C
C     COMPUTE AUTOCORRELATIONS FOR N >= 21
C
        AN=N
C
        SUM1=0.0
        DO4210I=1,N
          SUM1=SUM1+Y(I)
 4210   CONTINUE
        Y1BAR=SUM1/AN
C
        SUM1=0.0
        DO4220I=1,N
          SUM1=SUM1+(Y(I)-Y1BAR)*(Y(I)-Y1BAR)
 4220   CONTINUE
        VARB1=SUM1/AN
        VAR1=SUM1/(AN-1.0)
C
        DO4230K=1,KMAXM1
          SUM1=0.0
          NMK=N-K
          DO4240I=1,NMK
            J=I+K
            SUM1=SUM1+(Y(I)-Y1BAR)*(Y(J)-Y1BAR)
 4240     CONTINUE
          YTEMP1(K)=SUM1/AN
          YTEMP1(K)=YTEMP1(K)/VARB1
 4230   CONTINUE
      ENDIF
C
C               ******************************
C               **  STEP 42--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR LJUNG-BOX     TEST  **
C               ******************************
C
 4400 CONTINUE
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      SUM1=0.0
      DO4410I=1,KMAXM1
        SUM1=SUM1 + YTEMP1(I)*YTEMP1(I)/REAL(N-I)
 4410 CONTINUE
C
      Q=AN*(AN+2.0)*SUM1
      STATVA=Q
      CALL CHSCDF(Q,KMAXM1,CDF)
      STATCD=1.0-CDF
C
      CUT0=0.
C
      ALPHA=.5
      P2=1.0-ALPHA
      CALL CHSPPF(P2,KMAXM1,CUT50)
C
      ALPHA=.25
      P2=1.0-ALPHA
      CALL CHSPPF(P2,KMAXM1,CUT75)
C
      ALPHA=.10
      P2=1.0-ALPHA
      CALL CHSPPF(P2,KMAXM1,CUT90)
C
      ALPHA=.05
      P2=1.0-ALPHA
      CALL CHSPPF(P2,KMAXM1,CUT95)
C
      ALPHA=.01
      P2=1.0-ALPHA
      CALL CHSPPF(P2,KMAXM1,CUT99)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
C
C               *********************************
C               **   STEP 52--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR LJUNG-BOX TEST        **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5211)
 5211 FORMAT(
     1'              LJUNG-BOX TEST FOR RANDOMNESS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,5241)
 5241 FORMAT('1. STATISTICS:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5242)N
 5242 FORMAT(6X,'NUMBER OF OBSERVATIONS      = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5245)KMAXM1
 5245 FORMAT(6X,'LAG TESTED                  = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5343)YTEMP1(1)
 5343 FORMAT(6X,'LAG 1 AUTOCORRELATION       = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5345)YTEMP1(2)
 5345 FORMAT(6X,'LAG 2 AUTOCORRELATION       = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5347)YTEMP1(3)
 5347 FORMAT(6X,'LAG 3 AUTOCORRELATION       = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5349)STATVA
 5349 FORMAT(3X,'LJUNG-BOX TEST STATISTIC       = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,5438)
 5438 FORMAT('2. PERCENT POINTS OF THE REFERENCE CHI-SQUARE ',
     1       'DISTRIBUTION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5439)
 5439 FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF TEST STATISTIC ',
     1       'VALUE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5440)
 5440 FORMAT('   IS GREATER THAN PERCENT POINT VALUE)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5441)
 5441 FORMAT(3X,'FOR LJUNG-BOX TEST STATISTIC')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5445)CUT0
 5445 FORMAT(6X,'0          % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5446)CUT50
 5446 FORMAT(6X,'50         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5447)CUT75
 5447 FORMAT(6X,'75         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5448)CUT90
 5448 FORMAT(6X,'90         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5449)CUT95
 5449 FORMAT(6X,'95         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5450)CUT99
 5450 FORMAT(6X,'99         % POINT    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      CDF2=100.0*STATCD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5561)
 5561 FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
      CALL DPWRST('XXX','WRIT')
      IF(STATVA.LT.CUT95)THEN
        WRITE(ICOUT,5563)
 5563   FORMAT(6X,'THE DATA ARE RANDOM.')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,5565)
 5565   FORMAT(6X,'THE DATA ARE NOT RANDOM.')
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
 5290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'LUJ2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPLUJ2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),XTEMP(I)
 9017 FORMAT('I,Y(I),XTEMP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMABA(IHARG,IARGT,ARG,NUMARG,ADEMBA,MAXMAR,AMARBA,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER BASES.
C              THESE ARE LOCATED IN THE VECTOR AMARBA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADEMBA
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--AMARBA (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION AMARBA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMA'
      ISUBN2='BA  '
C
      NUMMAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMABA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ADEMBA
   55 FORMAT('ADEMBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)AMARBA(1)
   70 FORMAT('AMARBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,AMARBA(I)
   76 FORMAT('I,AMARBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=ADEMBA
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      AMARBA(1)=ADEMBA
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-1
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEMBA
      AMARBA(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,AMARBA(I)
 1276 FORMAT('THE BASE OF MARKER ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEMBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEMBA
      DO1315I=1,NUMMAR
      AMARBA(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)AMARBA(I)
 1316 FORMAT('THE BASE OF ALL MARKERS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMABA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ADEMBA
 9015 FORMAT('ADEMBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)AMARBA(1)
 9030 FORMAT('AMARBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,AMARBA(I)
 9036 FORMAT('I,AMARBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMACL(IHARG,NUMARG,IDEFMC,IMARCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE MARGIN
C              (THE REGION OUTSIDE THE FRAME LINES).
C              THE COLOR FOR THE MARGIN WILL BE PLACED
C              IN THE HOLLERITH VARIABLE IMARCO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFMC
C     OUTPUT ARGUMENTS--IMARCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFMC
      CHARACTER*4 IMARCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IMARCO=IDEFMC
      GOTO1180
C
 1160 CONTINUE
      IMARCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IMARCO
 1181 FORMAT('THE MARGIN COLOR HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPMACR(ICOM,ICOM2,
CCCCC THE FOLLOWING LINE WAS AUGMENTED    AUGUST 1994
CCCCC1IMACRO,IMACNU,IMACCS,
     1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IWIDTH,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IOFILE,
CCCCC1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--OPERATE ON MACROS (= SUB-PROGRAMS).
C              THERE ARE 3 CAPABILITITES IN THIS REGARD--
C                 1) TURN THE MACRO SWITCH 'ON' WHICH WILL
C                    ALLOW A MACRO TO BE CREATED.
C                 2) TURN THE MACRO SWITCH 'OFF' WHICH WILL
C                    TERMINATE THE CREATION OF A MACRO.
C                 3) ADD THE CONTENTS OF A MACRO TO THE INPUT RUNSTTREAM
C                    WHICH (IN EFFECT) WILL ALLOW A MACRO
C                    TO BE EXECUTED.
C
C     CALLED BY--MAIN, MAINSU
C
C     NOTE--THESE CAPABILITITIES
C           WILL ALLOW MACROS TO BE
C           DYNAMICALLY CONSTRUCTED AND USED
C           FROM WITHIN A DATAPLOT PROGRAM.
C           WHEN THE MACRO SWITCH IS ON,
C           ALL ENTERED DATAPLOT INSTRUCTIONS
C           ARE AUTOMATICALLY COPIED INTO
C           A SPECIFIED SYSTEM FILE OR SUBFILE.
C           WHEN THE MACRO SWITCH IS OFF,
C           NO SUCH COPYING IS DONE.
C           THE SPECIFIED STATUS (ON/OFF) OF THE MACRO
C           WILL BE PLACED
C           IN THE HOLLERITH VARIABLE IMACRO.
C           IMACL1 = FIRST LINE OF THE MACRO TO BE EXECUTED
C           IMACL2 = LAST  LINE OF THE MACRO TO BE EXECUTED
C           IMACLR = NUMBER OF LINES OF MACRO ALREADY READ
C     INPUT  ARGUMENTS--ICOM
C                     --ICOM2
C     INPUT  ARGUMENTS--IMACNU (AN INTEGER VALUE
C                              BY WHICH THE MACRO FILE/SUBFILE
C                              MAY BE REFERENCED IN A FORTRAN
C                              I/O STATEMENT.
C                     --IMACCS (A HOLLERITH VARIABLE
C                              CONTAINING STATUS INFORMATION
C                              FOR THE MACRO FILE/SUBFILE
C                     --IANSLC (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              ORIGINAL INPUT COMMAND LINE.
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE ORIGINAL COMMAND LINE.
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IBUG   (A HOLLERITH VARIABLE
C                              FOR DEBUGGING
C     OUTPUT ARGUMENTS--IMACRO (AN INTEGER VARIABLE
C                              WHICH IF 'ON' INDICATES THAT
C                              CURRENT COMMANDS ARE ALSO
C                              BEING DIVERTED
C                              SO AS TO CONSTRUCT A MACRO; AND
C                              IF OFF INDICATES THAT
C                              A MACRO IS NOT BEING CONSTRUCTED.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1983.
C     UPDATED         --SEPTEMBER 1983.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --MAY       1990. FOR CALL CASE, SET FILE STATUS='OLD'
C     UPDATED         --AUGUST    1994. SIMPLIFY CODE THROUGHOUT
C     UPDATED         --AUGUST    1994. EXECUTE A SUBSET OF A FILE
C     UPDATED         --APRIL     1997. DIFFERENT UNIT FOR "CREATE
C                                       FILE." CASE TO FIX BUG IF
C                                       "CALL FILE." ENCOUNTERED WHILE
C                                       CREATE IS ON.
C     UPDATED         --JULY      2003. BUG: FILE NAME < 80
C                                       CHARACTERS, BUT COMMAND LINE
C                                       > 80 CHARACTERS
C     UPDATED         --SEPTEMBER 2005. SUPPORT FOR ARGUMENTS TO
C                                       MACROS.  THIS ROUTINE STORES
C                                       THE ARGUMENTS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IOFILE
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 IANSI
CCCCC CHARACTER*80 ICANS
      CHARACTER*200 ICANS
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED     AUGUST 1994
CCCCC CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IBUGQ
      CHARACTER*1 ICJUNK
C
C ---------------------------------------------------------------------
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
C-----COMMON----------------------------------------------------------
C
 
CCCCC THE FOLLOWING LINE WAS ADDED        AUGUST 1994
CCCCC INCLUDE 'DPCOPA.INC'
CCCCC INCLUDE 'DPCODA.INC' BOMBS
      INCLUDE 'DPCOSU.INC'
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
C
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='CR  '
C
      IF(ICOM.EQ.'MACR' .AND. IHARG(1).EQ.'SUBS' .OR.
     1   IHARG(2).EQ.'CHAR')GOTO9000
C
      IFOUND='YES'
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS ADDED    AUGUST 1994
      MINN2=1
C
      KMIN=0
      KDEL=0
      KMAX=0
      JP3=0
      JP4=0
      JP5=0
      IH='UNKN'
      IH2='UNKN'
      J12=0
      J22=0
      J32=0
      J42=0
      J52=0
      J62=0
      J72=0
      J82=0
      J92=0
      J102=0
      IPAR2=0
      IPAR3=0
      IPAR4=0
      IPAR5=0
      IPAR6=0
      IPAR7=0
      IPAR8=0
      IPAR9=0
      IPAR10=0
C
      P2=0.0
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,51)
   51    FORMAT('***** AT THE BEGINNING OF DPMACR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,52)IMACRO,IMACNU,IMACCS,IMACL1,IMACL2
   52    FORMAT('IMACRO,IMACNU,IMACCS,IMACL1,IMACL2 = ',
     1   A4,I8,2X,A12,I8,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,53)IBUGS2,IERROR
   53    FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,54)MAXOBV
CCC54    FORMAT('MAXOBV = ',I8)
CCCCC    CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,55)ICOM,ICOM2,IWIDTH
   55    FORMAT('ICOM,ICOM2,IWIDTH = ',A4,2X,A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,56)(IANSLC(I),I=1,MIN(120,IWIDTH))
   56    FORMAT('IANSLC(.) = ',120A1)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,57)NUMARG
   57    FORMAT('NUMARG = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NUMARG.GE.1)THEN
            DO58I=1,NUMARG
               WRITE(ICOUT,59)I,IHARG(I),IHARG2(I)
   59          FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
               CALL DPWRST('XXX','BUG ')
   58       CONTINUE
         ENDIF
C
CCCCC    WRITE(ICOUT,62)NUMNAM,MAXOBVAM
CCC62    FORMAT('NUMNAM,MAXOBVAM = ',2I8)
         WRITE(ICOUT,62)NUMNAM
   62    FORMAT('NUMNAM= ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NUMNAM.GE.1)THEN
            DO65I=1,NUMNAM
               WRITE(ICOUT,66)I,IHNAME(I),IHNAM2(I),IUSE(I),
     1         IVALUE(I),VALUE(I)
   66          FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),',
     1         'IVALUE(I),VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
               CALL DPWRST('XXX','BUG ')
   65       CONTINUE
         ENDIF
C
         WRITE(ICOUT,72)NUMCHA
   72    FORMAT('NUMCHA = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,73)(IA(I),I=1,MIN(100,NUMCHA))
   73    FORMAT('(IA(I),I=1,NUMCHA) = ',100A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,81)ICRENU
   81    FORMAT('ICRENU = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,82)ICRENA
   82    FORMAT('ICRENA = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,83)ICREST
   83    FORMAT('ICREST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,84)ICREFO
   84    FORMAT('ICREFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,85)ICREAC
   85    FORMAT('ICREAC = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,86)ICREFO
   86    FORMAT('ICREFO = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,87)ICRECS
   87    FORMAT('ICRECS = ',A12)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FOR THE SPECIAL CASE WHEN THE                 **
C               **  EXECUTION OF A MACRO HAS JUST BEEN FINISHED,  **
C               **  JUMP TO CLOSING THE FILE                      **
C               ****************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMACCS.EQ.'CLO2        ')GOTO5000
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  FOR THE SPECIAL CASE WHEN HAVE THE       **
C               **  END CREATE     COMMAND, OR THE           **
C               **  END MACRO      COMMAND, OR THE           **
C               **  END OF CREATE      COMMAND,              **
C               **  END OF MACRO       COMMAND,              **
C               **  JUMP IMMEDIATELY TO THE SECTION OF CODE  **
C               **  WHICH PUTS ON AN END OF FILE AND         **
C               **  CLOSES THE FILE/SUBFILE.                 **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'END ')GOTO1210
      GOTO1290
 1210 CONTINUE
      IF(NUMARG.LE.0)GOTO1290
      IF(IHARG(1).EQ.'CREA')GOTO4000
      IF(IHARG(1).EQ.'MACR')GOTO4000
      IF(NUMARG.LE.1)GOTO1290
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'CREA')GOTO4000
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'MACR')GOTO4000
 1290 CONTINUE
C
C               ****************************************************************
C               **  STEP 13--
C               **  DETERMINE THE TYPE CASE--
C               **       1) OPERATE ON A MACRO RESIDING IN A FILE;
C               **       2) OPERATE ON A MACRO FROM THE TERMINAL (ILLEGAL).
C               **  NOTE--IOFILE  WILL EQUAL 'YES' ONLY IN FILE CASE.
C               **  IN OTHER WORDS, THIS STEP MAKES SURE
C               **  THAT A FILE NAME IS EXISTENT AFTER THE
C               **  CREATE   AND   CALL   COMMANDS.
C               ****************************************************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWORD=2
      CALL DPFILE(IANSLC,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
C
C               **********************************************
C               **  STEP 14--                               **
C               **  IF NO FILE NAME GIVEN,                  **
C               **  THEN GENERATE AN ERROR MESSAGE.         **
C               **********************************************
C
      ISTEPN='14'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.NE.'YES')THEN
         IERROR='YES'
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1411)
 1411    FORMAT('***** ERROR IN DPMACR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1412)
 1412    FORMAT('      THE DESIRED MACRO OPERATION')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1413)
 1413    FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1414)
 1414    FORMAT('      NO USER FILE NAME WAS GIVEN.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1415)
 1415    FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1416)
 1416    FORMAT('      THE PROPER FORM--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1417)
 1417    FORMAT('      SUPPOSE THE ANALYST WISHES TO EXECUTE A MACRO ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1419)
 1419    FORMAT('      RESIDING IN THE MASS STORAGE FILE    MAC3.  ,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1420)
 1420    FORMAT('      THEN THE FOLLOWING COMMAND LINE IS ENTERED--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1421)
 1421    FORMAT('         CALL MAC3.')
         CALL DPWRST('XXX','BUG ')
         GOTO9000
      ENDIF
C
C               *************************************
C               **  STEP 15--                      **
C               **  IF HAVE THE FILE INPUT CASE    **
C               **  (WHICH WE MUST HAVE)--         **
C               **  COPY OVER VARIABLES            **
C               *************************************
C
      ISTEPN='15'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ICRENU
      IFILE=ICRENA
      ISTAT=ICREST
      IF(IFILE.EQ.ISYSNA)ISTAT=ISYSST
      IF(IFILE.EQ.ILOGNA)ISTAT=ILOGST
      IFORM=ICREFO
      IACCES=ICREAC
      IPROT=ICREPR
C     (SEE ADDITIONAL RESETTING OF   IPROT   BELOW
C     IF HAVE THE SYSTEM LOGIN AND/OR THE LOCAL LOGIN MACRO FILES)
      ICURST=ICRECS
C
      ISUBN0='MACR'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
         WRITE(ICOUT,1513)IOUNIT
 1513    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1514)IFILE
 1514    FORMAT('IFILE = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1515)ISTAT,IFORM,IACCES,IPROT,ICURST
 1515    FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1   A12,2X,A12,2X,A12,2X,A12,2X,A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1516)ISUBN0,IERRFI
 1516    FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 16--                                **
C               **  IF HAVE THE FILE INPUT CASE--            **
C               **  (WHICH WE MUST HAVE)--                   **
C               **  CHECK TO SEE IF THE MACRO FILE MAY EXIST **
C               ***********************************************
C
      ISTEPN='16'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')THEN
         IERROR='YES'
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1611)
 1611    FORMAT('***** IMPLEMENTATION ERROR IN DPMACR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1612)
 1612    FORMAT('      THE DESIRED MACRO CREATE/CALL')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1613)
 1613    FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1614)
 1614    FORMAT('      THE INTERNAL VARIABLE    ICREST ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1615)
 1615    FORMAT('      WHICH ALLOWS SUCH MACRO OPERATIONS')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1616)
 1616    FORMAT('      HAS BEEN SET TO    NONE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1617)ISTAT,ICREST
 1617    FORMAT('ISTAT,ICREST = ',A12,2X,A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1618)
 1618    FORMAT('      PLEASE CONTACT YOUR DATAPLOT IMPLEMENTOR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1619)
 1619    FORMAT('      TO CORRECT THE SETTING IN SUBROUTINE INITFO.')
         CALL DPWRST('XXX','BUG ')
         GOTO9000
      ENDIF
C
C               ********************************
C               **  STEP 17--                 **
C               **  EXTRACT THE FILE NAME.    **
C               **  THIS IS NEEDED FOR MOST   **
C               **  (BUT NOT ALL) VARIATIONS  **
C               **  OF THE MACRO COMMAND.     **
C               ********************************
C
      ISTEPN='17'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1710I=1,200
         IANSI=IANSLC(I)
         ICANS(I:I)=IANSI(1:1)
 1710 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFILE,NCFILE,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NCFILE.LE.0)THEN
         IERROR='YES'
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1741)
 1741    FORMAT('***** ERROR IN DPMACR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1742)
 1742    FORMAT('      A USER FILE NAME IS REQUIRED')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1743)
 1743    FORMAT('      IN THE CREATE AND CALL COMMANDS')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1744)
 1744    FORMAT('      (FOR EXAMPLE,    CALL PROG7.DP)')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1745)
 1745    FORMAT('      BUT NONE WAS GIVEN HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1746)
 1746    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,1747)(IANSLC(I),I=1,MIN(100,IWIDTH))
 1747      FORMAT('      ',80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IF(IWIDTH.LE.0)THEN
           WRITE(ICOUT,999)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         GOTO9000
      ENDIF
C
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFILE.EQ.ISYSNA)IPROT=ISYSPR
      IF(IFILE.EQ.ILOGNA)IPROT=ILOGPR
C
C               *****************************************
C               **  STEP 25--                          **
C               **  CHECK THE DESIRED MACRO OPERATION  **
C               **  (ON, OFF, OR EXECUTE).             **
C               *****************************************
C
      ISTEPN='25'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'MACR'.AND.ICOM2.EQ.'O   ')GOTO2100
      IF(ICOM.EQ.'END '.AND.ICOM2.EQ.'    ')GOTO2200
      IF(ICOM.EQ.'CREA'.AND.ICOM2.EQ.'TE  ')GOTO2400
C
      IF(ICOM.EQ.'CALL'.AND.ICOM2.EQ.'    ')GOTO2500
      IF(ICOM.EQ.'ADD '.AND.ICOM2.EQ.'    ')GOTO2500
      IF(ICOM.EQ.'RUN '.AND.ICOM2.EQ.'    ')GOTO2500
      IF(ICOM.EQ.'EXEC'.AND.ICOM2.EQ.'UTE ')GOTO2500
      GOTO2900
C
 2100 CONTINUE
      IF(NUMARG.LE.0)GOTO2900
      IF(NUMARG.EQ.1)GOTO3000
      IF(IHARG(2).EQ.'ON')GOTO3000
      IF(IHARG(2).EQ.'OFF')GOTO4000
      IF(IHARG(2).EQ.'AUTO')GOTO3000
      IF(IHARG(2).EQ.'DEFA')GOTO4000
      IF(IHARG(2).EQ.'CLOS')GOTO5000
C
      IF(IHARG(2).EQ.'EXEC')THEN
        NSARG=3
        GOTO6000
      ELSEIF(IHARG(2).EQ.'ADD')THEN
        NSARG=3
        GOTO6000
      ELSEIF(IHARG(2).EQ.'CALL')THEN
        NSARG=3
        GOTO6000
      ELSEIF(IHARG(2).EQ.'RUN')THEN
        NSARG=3
        GOTO6000
      ENDIF
      GOTO2900
C
 2200 CONTINUE
      IF(NUMARG.LE.0)GOTO2900
      IF(IHARG(1).EQ.'CREA')GOTO4000
      IF(NUMARG.LE.1)GOTO2900
      IF(IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'CREA')GOTO4000
      GOTO2900
C
 2400 CONTINUE
      IF(NUMARG.LE.0)GOTO2900
      GOTO3000
C
 2500 CONTINUE
      NSARG=2
      IF(NUMARG.LE.0)GOTO2900
      GOTO6000
C
 2900 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2911)
 2911 FORMAT('***** ERROR IN DPMACR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2912)
 2912 FORMAT('      THE DESIRED MACRO OPERATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2913)
 2913 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2914)
 2914 FORMAT('      SPECIFIED OPERATION WAS ILLEGAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2915)
 2915 FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2916)
 2916 FORMAT('      THE PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2917)
 2917 FORMAT('      SUPPOSE THE ANALYST WISHES TO FORM A MACRO ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2919)
 2919 FORMAT('      USING THE MASS STORAGE FILE    MAC3.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2920)
 2920 FORMAT('      THEN THE FOLLOWING COMMAND LINE IS ENTERED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2921)
 2921 FORMAT('      CREATE MAC3.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ****************************************************************
C               **  STEP 30--
C               **  TREAT THE MACRO ON (= CREATE) CASE.
C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
C               **      1) AN OPENING OF THE FILE OR SUBFILE;
C               **      2) AN EQUIVALENCING OF THE FILE OR SUBFILE;
C               **      3) A  REWINDING OF THE FILE OR SUBFILE.
C               **  THE CODE BELOW
C               **  OPENS THE FILE OR SUBFILE (VIA @ASG,AX ON THE UNIVAC 1108).
C               **  THE CODE ALSO EQUIVALENCES THE FILES OR SUBFILES (VIA @USE
C               **  UNIVAC 1108) TO THE FORTRAN LOGICAL UNIT NUMBER DESIGNATED
C               **  IN THE VARIABLE IMACNU (IN THE SUBROUTINE
C               **  INITFO);
C               **  THE CODE ALSO REWINDS THE FILE OR SUBFILE. (VIA @REWIND ON
C               **  UNIVAC 1108).
C               ****************************************************************
C
 3000 CONTINUE
      ISTEPN='30'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMACRO='ON'
CCCCC IOUNIT=IMACNU       OCTOBER 8, 1986
CCCCC APRIL 1997.  SEPARATE UNIT FOR CREATE AND CALL TO AVOID INFINITE
CCCCC LOOP
CCCCC IOUNIT=ICRENU
      IOUNIT=ICREN2
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      IMACCS=ICURST
C
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,3011)
 3011    FORMAT('THE CREATE (MACRO) SWITCH HAS JUST BEEN TURNED ON.')
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ****************************************************************
C               **  STEP 40--
C               **  TREAT THE MACRO OFF (= END OF CREATE) CASE.
C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
C               **      1) A PLACING OF AN END MARK OF THE FILE OR SUBFILE;
C               **      2) A FREEING (DEASSIGNING) OF THE FILE OR SUBFILE;
C               ****************************************************************
C
 4000 CONTINUE
      ISTEPN='40'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMACRO='OFF'
CCCCC IOUNIT=IMACNU       OCTOBER 8, 1986
CCCCC APRIL 1997.  SEPARATE UNIT FOR CREATE AND CALL
CCCCC IOUNIT=ICRENU
      IOUNIT=ICREN2
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,4011)
 4011    FORMAT('THE CREATE (MACRO) SWITCH HAS JUST BEEN TURNED OFF.')
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ****************************************************************
C               **  STEP 50--
C               **  TREAT THE MACRO CLOSE CASE.
C               ****************************************************************
C
 5000 CONTINUE
      ISTEPN='50'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IMACRO='OFF'
      IOUNIT=IMACNU
C
      IENDFI='OFF'
C     ***** DO WE NEED THE FOLLOWING REWIND ????? *****
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,5011)IMACNU
 5011    FORMAT('MACRO FILE NUMBER ',I8,' HAS JUST BEEN CLOSED')
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ****************************************************************
C               **  STEP 60--
C               **  TREAT THE MACRO (= CALL) CASE.
C               **  CARRY OUT WHATEVER SYSTEM OPERATIONS ARE NEEDED
C               **  IN ORDER TO OPERATE ON THE FILE OR SUBFILE.
C               **  FOR MOST INSTALLATIONS, THIS REQUIRES
C               **      1) AN OPENING OF THE FILE OR SUBFILE;
C               **      2) AN EQUIVALENCING OF THE FILE OR SUBFILE;
C               **      3) A  REWINDING OF THE FILE OR SUBFILE.
C               **      4) SKIPPING OVER ANY FRONT LINES              **
C               ****************************************************************
C
 6000 CONTINUE
      ISTEPN='60'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING SECTION WAS ADDED   AUGUST 1994
CCCCC TO ALLOW FOR FOR/SUBSET           AUGUST 1994
C               *****************************************
C               **  STEP 61--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='61'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ICASEQ='FULL'
CCCCC ILOCQ=NUMARG+1
CCCCC IF(NUMARG.LE.0)GOTO6190
CCCCC DO6100J=1,NUMARG
CCCCC    J1=J
CCCCC    IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
CCCCC       ICASEQ='SUBS'
CCCCC       ILOCQ=J1
CCCCC       GOTO6190
CCCCC    ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
CCCCC       ICASEQ='SUBS'
CCCCC       ILOCQ=J1
CCCCC       GOTO6190
CCCCC    ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
CCCCC       ICASEQ='FOR'
CCCCC       ILOCQ=J1
CCCCC       GOTO6190
CCCCC    ENDIF
C6100 CONTINUE
C6190 CONTINUE
C
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
CCCCC    WRITE(ICOUT,6191)NUMARG,ILOCQ,ICASEQ,MAXOBV
C6191    FORMAT('NUMARG,ILOCQ,ICASEQ,MAXOBV = ',I8,I8,2X,A4,I8)
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED   AUGUST 1994
CCCCC TO ALLOW FOR FOR/SUBSET           AUGUST 1994
C               *********************************************
C               **  STEP 62--                              **
C               **  BRANCH    TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='62'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(ICASEQ.EQ.'FULL')THEN
CCCCC    DO6215I=1,MAXOBV
CCCCC       ISUB(I)=1
C6215    CONTINUE
CCCCC    NQ=MAXOBV
CCCCC ELSEIF(ICASEQ.EQ.'SUBS')THEN
CCCCC    NIOLD=MAXOBV
CCCCC    CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
CCCCC    NQ=NIOLD
CCCCC ELSEIF(ICASEQ.EQ.'FOR')THEN
CCCCC    NIOLD=MAXOBV
CCCCC    CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
CCCCC1   NLOCAL,ILOCS,NS,IBUGQ,IERROR)
CCCCC    NQ=NFOR
CCCCC    NMXFOR=IROWN
CCCCC ENDIF
C
CCCCC IF(NQ.LT.MINN2)THEN
CCCCC    WRITE(ICOUT,999)
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6241)
C6241    FORMAT('***** ERROR IN DPMACR--')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6242)
C6242    FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
CCCCC1   'EXTRACTED,')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6243)
C6243    FORMAT('      THE NUMBER OF SPECIFIED FILE LINES')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6244)
C6244    FORMAT('      TO BE CALLED/EXECUTED ')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6246)MINN2
C6246    FORMAT('      MUST BE ',I8,' OR LARGER;')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6247)
C6247    FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    WRITE(ICOUT,6248)
C6248    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC    IF(IWIDTH.GE.1)WRITE(ICOUT,6249)(IANSLC(I),I=1,IWIDTH)
C6249    FORMAT('      ',80A1)
CCCCC    IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC    IERROR='YES'
CCCCC    GOTO9000
CCCCC ENDIF
C
CCCCC NS=NQ
C
CCCCC IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
CCCCC    WRITE(ICOUT,6261)MAXOBV,NQ,IMACL1,IMACL2,MINN2
C6261    FORMAT('MAXOBV,NQ,IMACL1,IMACL2,MINN2 = ',5I8)
CCCCC    CALL DPWRST('XXX','BUG ')
CCCCC ENDIF
C
C               **************************************************
C               **  STEP 63--                                   **
C               **  FIND THE FIRST AND LAST ROW OF THE SUB-CHUNK**
C               **  OF THE FILE BEING EXECUTED                  **
C               **  IMACL1 = FIRST LINE TO BE EXECUTED          **
C               **  IMACL2 = LAST  LINE TO BE EXECUTED          **
C               **  IMACLR = NUMBER OF LINES ALREADY EXECUTED   **
C               **************************************************
C
      ISTEPN='63'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IMACL1=1
CCCCC DO6350I=1,NQ
CCCCC    IF(ISUB(I).EQ.1)THEN
CCCCC       IMACL1=I
CCCCC       GOTO6359
CCCCC    ENDIF
C6350 CONTINUE
C6359 CONTINUE
C
CCCCC IMACL2=NQ
CCCCC DO6360I=1,NQ
CCCCC    IREV=NQ-I+1
CCCCC    IF(ISUB(IREV).EQ.1)THEN
CCCCC       IMACL2=IREV
CCCCC       GOTO6369
CCCCC    ENDIF
C6360 CONTINUE
C6369 CONTINUE
C
CCCCC THE FOLLOWING IS A PATCH                          AUGUST 1994
CCCCC TO MAKE    CALL  FOR I = ... ... ... WORK   AUGUST 1994
C
CCCCC SEPTEMBER 2005.  IF NO FOR CLAUSE, THEN INTERPRET ANY
CCCCC                  ARGUMENTS AFTER "CALL FILE." AS COMMAND
CCCCC                  LINE ARGUMENTS.
CCCCC
CCCCC                  IF THIS IS THE FIRST LEVEL CALL, CLEAR THE
CCCCC                  COMMAND LINE ARGUMENTS IF NO ARGUMENTS ARE
CCCCC                  GIVEN.
C
      IMACL1=1
CCCCC IMACL2=1000
      IMACL2=100000
C
      IF(IMALEV.EQ.1)THEN
        DO6380II=1,10
          IMACAR(II)=' '
 6380   CONTINUE
        NMACAG=0
      ENDIF
C
      IF(IHARG(2).EQ.'FOR ')THEN
         IF(NUMARG.GE.7)THEN
            IMACL1=IARG(5)
            IMACL2=IARG(7)
         ENDIF
      ELSE IF(NUMARG.GE.NSARG)THEN
        NMACAG=0
        DO6390II=1,10
          IMACAR(II)=' '
 6390   CONTINUE
        DO6370J=NSARG,NUMARG
          NMACAG=NMACAG+1
          IF(NMACAG.GT.10)GOTO6370
          ISTART=1
          ISTOP=IWIDTH
          IWORD=NSARG+NMACAG
          CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1                ICOL1,ICOL2,IMACAR(NMACAG),NCTEMP,
     1                IBUGS2,ISUBRO,IERROR)
          IF(IBUGS2.EQ.'ON' .OR. ISUBRO.EQ.'MACR')THEN
            WRITE(ICOUT,6373)NMACAG,IMACAR(NMACAG)(1:MIN(40,NCTEMP))
 6373       FORMAT('CALL ARGUMENT ',I3,' = ',A40)
            CALL DPWRST('XXX','BUG ')
          ENDIF
 6370   CONTINUE
      ENDIF
C
C               **************************************************
C               **  STEP 64--                                   **
C               **  THE CODE BELOW
C               **  OPENS THE FILE OR SUBFILE (VIA @ASG,AX ON THE UNIVAC 1108).
C               **  THE CODE ALSO EQUIVALENCES THE FILES OR SUBFILES (VIA @USE
C               **  UNIVAC 1108) TO THE FORTRAN LOGICAL UNIT NUMBER DESIGNATED
C               **  IN THE VARIABLE IMACNU (IN THE MAIN PROGRAM);
C               **  THE RECOMMENDED VALUE FOR IMACNU IS 34; IF THIS
C               **  IS INAPPROPRIATE, MAKE CHANGES IN INITHK AND DPSYOP.
C               **  THE CODE ALSO REWINDS THE FILE OR SUBFILE. (VIA @REWIND ON
C               **  UNIVAC 1108).
C               ****************************************************************
C
      ISTEPN='64'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IMACRO='EXEC'
CCC?? IOUNIT=IMACN2
      IOUNIT=IMACNU
C
      IREWIN='ON'
CCCCC MAY,1990.  SET ISTAT TO "OLD" FOR CALL CASE.  DO THIS SO WILL
CCCCC SEARCH THE SYSTEM DIRECTORY IF NOT FOUND AS REQUESTED. (ALAN)
      ISTAT='OLD'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      IMACRO='EXEC'
      IMACCS=ICURST
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,6411)
 6411    FORMAT('A MACRO FILE HAS JUST BEEN OPENED FOR EXECUTION')
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED    AUGUST 1994
C               **************************************************
C               **  STEP 65--                                   **
C               **  IF THE CALL COMMAND IS EXECUTING ONLY A     **
C               **  (NECESSARILY CONTIGUOUS) PART OF A FILE,    **
C               **  THEN SKIP OVER ANY NON-EXECUTING FRONT LINES**
C               **  OF THE FILE (THAT IS, READ THE FILE         **
C               **  FROM LINE 1 TO LINE (IMACL1-1)).            **
C               **************************************************
C
      ISTEPN='65'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMACLR=0
      IF(IMACL1.GE.2)THEN
         IMAX=IMACL1-1
         DO6500I=1,IMAX
CCCCC       CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
CCCCC1      IA,NUMCHA,
CCCCC1      ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
CCCCC       IF(IERROR.EQ.'YES')GOTO9000
CCCCC THE FOLLOWING IS ALSO A PATCH   FOR   CALL  FOR ETC.
            IMACLR=IMACLR+1
            READ(IOUNIT,6511)ICJUNK
 6511       FORMAT(A1)
 6500    CONTINUE
      ENDIF
      GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MACR')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9011)
 9011    FORMAT('***** AT THE END       OF DPMACR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9012)IMACRO,IMACNU,IMACCS,IMACL1,IMACL2
 9012    FORMAT('IMACRO,IMACNU,IMACCS,IMACL1,IMACL2 = ',
     1   A4,I8,2X,A12,I8,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9013)IBUGS2,IFOUND,IERROR
 9013    FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9014)IOUNIT
 9014    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9015)ICOM,ICOM2,IWIDTH
 9015    FORMAT('ICOM,ICOM2,IWIDTH = ',A4,2X,A4,I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9017)(IANSLC(I),I=1,MIN(120,IWIDTH))
 9017    FORMAT('IANSLC(.) = ',120A1)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,9018)NUMARG
 9018    FORMAT('NUMARG = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NUMARG.GE.1)THEN
            DO9019I=1,NUMARG
               WRITE(ICOUT,9020)I,IHARG(I),IHARG2(I)
 9020          FORMAT('I,IHARG(I),IHARG2(I) = ',I8,2X,A4,2X,A4)
               CALL DPWRST('XXX','BUG ')
 9019       CONTINUE
         ENDIF
C
         WRITE(ICOUT,9025)IOFILE
 9025    FORMAT('IOFILE = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9031)JP3,JP4,JP5,KMIN,KDEL,KMAX
 9031    FORMAT('JP2,JP3,JP4,KMIN,KDEL,KMAX = ',6I8)
         CALL DPWRST('XXX','BUG ')
C
         WRITE(ICOUT,9032)NUMNAM
 9032    FORMAT('NUMNAM = ',I8)
         CALL DPWRST('XXX','BUG ')
         IF(NUMNAM.GE.1)THEN
            DO9035I=1,NUMNAM
               WRITE(ICOUT,9036)I,IHNAME(I),IHNAM2(I),IUSE(I),
     1         IVALUE(I),VALUE(I)
 9036          FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),',
     1         'IVALUE(I),VALUE(I) = ',I8,2X,A4,2X,A4,2X,A4,I8,E15.7)
               CALL DPWRST('XXX','BUG ')
 9035       CONTINUE
         ENDIF
C
         WRITE(ICOUT,9042)NUMCHA
 9042    FORMAT('NUMCHA = ',I8)
         CALL DPWRST('XXX','BUG ')
         IMAX=NUMCHA
         IF(NUMCHA.GE.120)IMAX=120
         WRITE(ICOUT,9043)(IA(I),I=1,IMAX)
 9043    FORMAT('(IA(I),I=1,IMAX) = ',100A1)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9051)IOUNIT
 9051    FORMAT('IOUNIT = ',I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9052)IFILE
 9052    FORMAT('IFILE  = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9053)ISTAT
 9053    FORMAT('ISTAT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9054)IFORM
 9054    FORMAT('IFORM  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9055)IACCES
 9055    FORMAT('IACCES = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9056)IPROT
 9056    FORMAT('IPROT  = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9057)ICURST
 9057    FORMAT('ICURST = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9058)IENDFI
 9058    FORMAT('IENDFI = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9059)IREWIN
 9059    FORMAT('IREWIN = ',A4)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9061)ISUBN0
 9061    FORMAT('ISUBN0 = ',A12)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,9062)IERRFI
 9062    FORMAT('IERRFI = ',A12)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMAIL(IANSLC,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DISPLAY DATAPLOT MAIL
C              FOR A GIVEN ANALYST.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANSLC
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IANSI
      CHARACTER*80 ICANS
      CHARACTER*80 ICUSER
      CHARACTER*80 ISTRIN
      CHARACTER*4 IMAIL
C
      DIMENSION IANSLC(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='IL  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MAIL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IMAINU
   61 FORMAT('IMAINU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IMAINA
   62 FORMAT('IMAINA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IMAIST
   63 FORMAT('IMAIST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IMAIFO
   64 FORMAT('IMAIFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IMAIAC
   65 FORMAT('IMAIAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IMAIFO
   66 FORMAT('IMAIFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IMAICS
   67 FORMAT('IMAICS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IMAINU
      IFILE=IMAINA
      ISTAT=IMAIST
      IFORM=IMAIFO
      IACCES=IMAIAC
      IPROT=IMAIPR
      ICURST=IMAICS
C
      ISUBN0='MAIL'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MAIL')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ****************************************
C               **  STEP 12--                         **
C               **  CHECK TO SEE IF MAIL FILE EXISTS  **
C               ****************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPMAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED MAIL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH MAIL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IMAIST
 1217 FORMAT('ISTAT,IMAIST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ****************************
C               **  STEP 13--             **
C               **  EXTRACT THE USER NAME **
C               ****************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
      IANSI=IANSLC(I)
      ICANS(I:I)=IANSI(1:1)
 1310 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ICUSER,NCUSER,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NCUSER.GE.1)GOTO1349
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('***** ERROR IN DPMAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      A USER NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      IN THE MAIL COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      (FOR EXAMPLE,    MAIL JONES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1345)
 1345 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1346)
 1346 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1347)(IANSLC(I),I=1,IWIDTH)
 1347 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1349 CONTINUE
C
 1390 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               **********************************************
C               **  STEP 41--                               **
C               **  READ THE FILE.                          **
C               **  FIND THE FIRST LINE OF THE SECTION.     **
C               **  WITH THE USER'S MAIL.                   **
C               **********************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAIL='UNKN'
C
      ANUMLI=0.0
      READ(IOUNIT,4111,END=4140)ANUMLI
 4111 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
C
      IF(NUMLIN.LE.0)GOTO4140
      DO4120I=1,NUMLIN
      I2=I
      READ(IOUNIT,4121,END=4140)(ISTRIN(J:J),J=1,80)
 4121 FORMAT(80A1)
      IF(ISTRIN(1:NCUSER).EQ.ICUSER(1:NCUSER))GOTO4130
 4120 CONTINUE
      GOTO4140
C
 4130 CONTINUE
      IMAIL='YES'
      ILUSER=I2
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4131)(ISTRIN(J:J),J=1,JMAX)
 4131 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO4190
C
 4140 CONTINUE
      IMAIL='NO'
      WRITE(ICOUT,4141)
 4141 FORMAT('***** NO MAIL *****')
      CALL DPWRST('XXX','BUG ')
      GOTO4190
C
 4190 CONTINUE
C
C               **********************************************
C               **  STEP 42--                               **
C               **  READ THE FILE.                          **
C               **  WRITE OUT EACH LINE IN THE SECTION.     **
C               **********************************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMAIL.EQ.'NO')GOTO4290
      IF(IMAIL.EQ.'UNKN')GOTO4290
C
      ILUSEP=ILUSER+1
      IF(ILUSEP.GT.NUMLIN)GOTO4290
      DO4220I=ILUSEP,NUMLIN
      I2=I
      READ(IOUNIT,4221,END=4290)(ISTRIN(J:J),J=1,80)
 4221 FORMAT(80A1)
      IF(ISTRIN(1:10).EQ.'----------')GOTO4290
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4222)(ISTRIN(J:J),J=1,JMAX)
 4222 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
 4220 CONTINUE
C
 4290 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MAIL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MAIL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMAIL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IMAIL
 9041 FORMAT('IMAIL = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMAND(ICAPSW,IFORSW,ISUBRO,IBUGA2,IBUGA3,IBUGQ,
     1                  IFOUND,IERROR)
C
C     PURPOSE--COMPUTE CONSENSUS MEANS USING FOLLOWING APPROACHES:
C              1) MANDEL-PAULE
C              2) MODIFIED MANDEL-PAULE
C              3) MAXIMUM LIKELIHOOD (VANGEL-RUHKIN)
C              4) BOB (ONLY IF NUMBER OF LABS = 2 - 5
C              5) SCHILLER-EBERHARDT
C              6) T-METHOD
C              7) GRAYBILL-DEAL
C     WRITTEN BY--CODE FOR MANDEL-PAULE, MAXIMUM LIKELIHOOD 
C                 PROVIDED BY MARK VANGEL, BOB BASED ON MACROS
C                 PROVIDED BY STEFAN LEIGH.
C                 JIM FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2000/10
C     ORIGINAL VERSION--OCTOBER   2000.
C     UPDATED         --AUGUST    2001. IWRITE VARIABLE
C     UPDATED         --OCTOBER   2002. SUPPORT FOR "CAPTURE HTML"
C                                       (ADD ICAPSW TO CALL LIST)
C     UPDATED         --MARCH     2006. ADD IFORSW TO CALL LIST
C                                       DPMAN2 COMPLETELY REWRITTEN:
C                                       1) CODE MODULARIZED INTO
C                                          DISTINCT SUBROUTINES
C                                       2) FORMATTING REVISED FOR
C                                          CONSISTENCY AND CLARITY
C                                       3) NEW METHODS ADDED
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IFORSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
C
      DIMENSION Z1(MAXOBV)
      DIMENSION IZ(MAXOBV)
      DOUBLE PRECISION Z2(MAXOBV)
      DOUBLE PRECISION Z3(MAXOBV)
      DOUBLE PRECISION Z4(MAXOBV)
      DOUBLE PRECISION Z5(MAXOBV)
      DIMENSION Z6(MAXOBV)
      DIMENSION Z7(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Z1(1))
      EQUIVALENCE (GARBAG(IGARB5),Z2(1))
      EQUIVALENCE (GARBAG(IGARB7),Z3(1))
      EQUIVALENCE (GARBAG(IGARB9),Z4(1))
      EQUIVALENCE (GARBAG(JGAR12),Z5(1))
      EQUIVALENCE (GARBAG(JGAR14),Z6(1))
      EQUIVALENCE (GARBAG(JGAR15),Z7(1))
C
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (IGARBG(IIGAR1),IZ(1))
C
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
C
C-----COMMON----------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C----------------------------------------------------------------
C
C-----COMMON VARIABLES (GENERAL)---------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='ND  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MAXV2=3
      MINN2=2
C
      ICASEQ='UNKN'
C
C               **************************************
C               **  TREAT THE MANDEL ANALYSIS CASE  **
C               **************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'MAND'.AND.
     1IHARG(1).EQ.'PAUL')GOTO111
      IF(NUMARG.GE.1.AND.ICOM.EQ.'MAND'.AND.
     1IHARG(1).EQ.'ANAL')GOTO111
      IF(NUMARG.GE.2.AND.ICOM.EQ.'MAND'.AND.
     1IHARG(1).EQ.'PAUL'.AND.IHARG(2).EQ.'ANAL')GOTO112
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'CONS'.AND.
     1IHARG(1).EQ.'MEAN')GOTO111
      IF(NUMARG.GE.2.AND.ICOM.EQ.'CONS'.AND.
     1IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'ANAL')GOTO112
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'BOB '.AND.
     1IHARG(1).EQ.'ANAL')GOTO111
C
      IF(ICOM.EQ.'MAND')GOTO190
      IF(ICOM.EQ.'BOB ')GOTO190
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               **************************************************
C               **  STEP 2--                                    **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT        **
C               **  ARGUMENTS.                                  **
C               **************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS**
C               **  (NLEFT)                                    **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.    **
C               *************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPMAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      CONSENSUS MEANS ANALYSIS WAS TO HAVE BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      CARRIED OUT MUST BE ',I8,' OR LARGER;  SUCH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)NLEFT
  316 FORMAT('      WAS NOT THE CASE HERE.  NLEFT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,319)(IANS(I),I=1,MAX(IWIDTH,80))
  319 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************
C               **  STEP 6--                            **
C               **  CHECK FOR A VALID NUMBER            **
C               **  OF VARIABLES (2 OR 3).              **
C               **  CHECK THE VALIDITY OF EACH          **
C               **  OF THE VARIABLES (THAT IS, FOR EACH **
C               **  OF THE VARIABLES, DOES THE NAME     **
C               **  EXIST IN THE TABLE?  DOES THE NUMBER**
C               **  OF ELEMENTS  AGREE WITH THE NUMBER  **
C               **  OF ELEMENTS IN THE FIRST VARIABLE?  **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(2.LE.NUMVAR.AND.NUMVAR.LE.MAXV2)GOTO520
C
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPMAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A CONSENSUS MEAN ANALYSIS, THE NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,514)MAXV2
  514 FORMAT('      VARIABLES MUST BE AT LEAST 2 AND AT MOST ',
     1       I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,515)
  515 FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,517)NUMVAR
  517 FORMAT('      NUMBER OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,519)(IANS(I),I=1,MAX(80,IWIDTH))
  519 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  520 CONTINUE
      DO530IFAC=2,NUMVAR
      J=IFAC
      IHFACT=IHARG(J)
      IHFAC2=IHARG2(J)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFAC.EQ.2)THEN
        IHRIGH=IHFACT
        IHRIG2=IHFAC2
      ELSEIF(IFAC.EQ.3)THEN
        IHRI21=IHFACT
        IHRI22=IHFAC2
      ENDIF
      ICOLIV(IFAC-1)=IVALUE(ILOCV)
      NIV(IFAC-1)=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,532)IFAC,IHFACT,IHFAC2,
     1ICOLIV(IFAC-1),NIV(IFAC-1)
  532 FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC-1),NIV(IFAC-1) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      DO540IFAC=1,NUMVAR-1
      IF(NIV(IFAC).NE.NLEFT)GOTO550
  540 CONTINUE
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPMAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CONSENSUS MEAN ANALYSIS, THE NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      ELEMENTS IN EACH VARIABLE SHOULD BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.  THE FIRST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)IHLEFT,IHLEF2,NLEFT
  562 FORMAT('      VARIABLE',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      INDEPENDENT VARIABLES (FACTORS)--')
      CALL DPWRST('XXX','BUG ')
      DO565IFAC=1,NUMVAR-1
      J=IFAC+1
      WRITE(ICOUT,566)IHARG(J),IHARG2(J),NIV(IFAC)
  566 FORMAT('      VARIABLE',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  565 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,567)
  567 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,568)(IANS(I),I=1,MAX(80,IWIDTH))
  568 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
         IF(ISUB(I).EQ.0)GOTO660
         J=J+1
C
         IJ=MAXN*(ICOLL-1)+I
         IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
         IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
         IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
         IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
         IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
         IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
         IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
         IFAC=1
         ICOLR=ICOLIV(IFAC)
         IJ=MAXN*(ICOLR-1)+I
         IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ)
         IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I)
         IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I)
         IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I)
         IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I)
         IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I)
         IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I)
         IF(NUMVAR.LE.2)GOTO660
C
         IFAC=2
         ICOLR=ICOLIV(IFAC)
         IJ=MAXN*(ICOLR-1)+I
         IF(ICOLR.LE.MAXCOL)Y3(J)=V(IJ)
         IF(ICOLR.EQ.MAXCP1)Y3(J)=PRED(I)
         IF(ICOLR.EQ.MAXCP2)Y3(J)=RES(I)
         IF(ICOLR.EQ.MAXCP3)Y3(J)=YPLOT(I)
         IF(ICOLR.EQ.MAXCP4)Y3(J)=XPLOT(I)
         IF(ICOLR.EQ.MAXCP5)Y3(J)=X2PLOT(I)
         IF(ICOLR.EQ.MAXCP6)Y3(J)=TAGPLO(I)
C
  660 CONTINUE
      NS=J
C
C               **************************************************
C               **  STEP 8--                                    **
C               **  PREPARE FOR ENTRANCE INTO DPMAN2--          **
C               **************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH='SIGM'
      IH2='AH  '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        SIGMAH=0.0
      ELSE
        SIGMAH=VALUE(ILOCP)
        IF(SIGMAH.LT.0.0)SIGMAH=0.0
      ENDIF
      IH='DFH '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        IDFH=1
      ELSE
        IDFH=INT(VALUE(ILOCP)+ 0.5)
      ENDIF
      IF(IDFH.LE.0)IDFH=1
C
C               ***********************************************
C               **  STEP 9--                                 **
C               **  CARRY OUT THE CONSENSUS MEANS ANALYSIS   **
C               ***********************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO790
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,711)
  711 FORMAT('***** FROM DPMAND, AS WE ARE ABOUT TO CALL DPMAN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMVAR
  712 FORMAT('NLEFT,MAXN,NS,NUMVAR = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO715I=1,NS
      WRITE(ICOUT,716)I,Y(I),Y2(I),Y3(I)
  716 FORMAT('I,Y1(I),Y2(I),Y3(I) = ',
     1I6,2X,3G15.7)
      CALL DPWRST('XXX','BUG ')
  715 CONTINUE
      WRITE(ICOUT,731)IBUGA3
  731 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
  790 CONTINUE
C
      IWRITE='OFF'
      CALL DPMAN2(Y1,Y2,Y3,NS,NUMVAR,
     1Z1,Z2,Z3,Z4,Z5,Z6,Z7,IZ,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1SIGMAH,IDFH,
     1XGRAND,S2WPOO,SW,
     1SET1,SET2,
     1XMPS,S2BMPS,SEMP,
     1XMMPS,S2BMMP,SEMMP,
     1XMLS,S2BMLS,SEML,
     1XSE,XSES2,ABIAS,ISEDF,
     1ASM,ASB,AKU,
CCCCC MARCH   2006.  ADD FOLLOWING 2 LINES TO CALL LIST
     1XGD,XGDS2,
     1XGCI,XDL,XDLS2,SEDLK1,SEGCI,
     1XFW,SEFWK1,SEFWK2,
     1XBCP,XBCPSE,XBCPK1,XBCPK2,
     1IWRITE,
CCCCC OCTOBER 2002.  ADD ICAPSW, ICAPTY TO CALL LIST
CCCCC MARCH   2006.  ADD IFORSW TO CALL LIST
     1ICAPSW,ICAPTY,IFORSW,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH='XGRA'
      IH2='ND  '
      VALUE0=XGRAND
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='S2PO'
      IH2='OOL '
      VALUE0=S2WPOO
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='T1ST'
      IH2='DERR'
      VALUE0=SET1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='T2ST'
      IH2='DERR'
      VALUE0=SET2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SEME'
      IH2='AN  '
      VALUE0=XSE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SES2'
      IH2='    '
      VALUE0=XSES2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BIAS'
      IH2='ALLO'
      VALUE0=ABIAS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SEDF'
      IH2='    '
      VALUE0=REAL(ISEDF)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MPME'
      IH2='AN  '
      VALUE0=XMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MPS2'
      IH2='    '
      VALUE0=S2BMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SEMP'
      IH2='    '
      VALUE0=SEMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MMPM'
      IH2='EAN '
      VALUE0=XMMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MMPS'
      IH2='2   '
      VALUE0=S2BMMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SEMM'
      IH2='P   '
      VALUE0=SEMMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MLME'
      IH2='AN  '
      VALUE0=XMLS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='MLS2'
      IH2='    '
      VALUE0=S2BMLS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='SEML'
      IH2='    '
      VALUE0=SEML
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOBM'
      IH2='EAN '
      VALUE0=ASM
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOBS'
      IH2='2   '
      VALUE0=ASB
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOBS'
      IH2='2W  '
      VALUE0=SW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BOBK'
      IH2='U   '
      VALUE0=AKU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GDME'
      IH2='AN  '
      VALUE0=XGD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GDS2'
      IH2='    '
      VALUE0=XGDS2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GCIM'
      IH2='EAN '
      VALUE0=XGCI
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='GCIS'
      IH2='E   '
      VALUE0=SEGCI
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='DERS'
      IH2='MEAN'
      VALUE0=XDL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='DERS'
      IH2='VARI'
      VALUE0=XDLS2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='DERS'
      IH2='SE  '
      VALUE0=SEDLK1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='FAIR'
      IH2='MEAN'
      VALUE0=XFW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='FAIR'
      IH2='SE  '
      VALUE0=SEFWK1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BCPM'
      IH2='EAN '
      VALUE0=XBCP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='BCPS'
      IH2='E   '
      VALUE0=XBCPSE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NS,NUMVAR
 9014 FORMAT('NS,NUMVAR = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMAN2(Y1,Y2,Y3,NPTS,NUMVAR,
     1DAT,X,T,THAT,W,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1SIGMAH,IDFH,
     1XGRAND,S2WPOO,SW,
     1SET1,SET2,
     1XMPS,S2BMPS,SEMP,
     1XMMPS,S2BMMP,SEMMP,
     1XMLS,S2BMLS,SEML,
     1XSE,XSES2,ABIAS,ISEDF,
     1ASM,ASB,AKU,
     1XGD,XGDS2,
     1XGCI,XDL,XDLS2,SEDLK1,SEGCI,
     1XFW,SEFWK1,SEFWK2,
     1XBCP,XBCPSE,XBCPK1,XBCPK2,
     1IWRITE,
CCCCC OCTOBER 2002.  ADD ICAPSW, ICAPTY TO CALL LIST
     1ICAPSW,ICAPTY,IFORSW,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--PERFORM A CONSENSUS MEAN ANALYSIS USING FOLLOWING
C              APPROACHES
C              1) MANDEL-PAULE
C              2) MODIFIED MANDEL-PAULE
C              3) VANGEL-RUKHIN MAXIMUM LIKELIHOOD
C              4) BOB
C              5) SCHILLER-EBERHARDT
C              6) MEAN OF MEANS
C              7) GRAYBILL-DEAL
C              8) GRAND MEAN
C              9) GENERALZIED TOLERANCE INTERVALS
C             10) DERSIMONIAN AND LARID
C     WRITTEN BY--CODE FOR MANDEL-PAULE, MAXIMUM LIKELIHOOD 
C                 PROVIDED BY MARK VANGEL, BOB BASED ON MACROS
C                 PROVIDED BY STEFAN LEIGH.
C     PRINTING--YES
C     SUBROUTINES NEEDED--FCDF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2000/10
C     ORIGINAL VERSION--OCTOBER   2000.
C     UPDATED  VERSION--FEBRUARY  2001. FROM JAMES YEN, A FEW
C                                       TERMINOLOGY CHANGES,
C                                       FIX TO BOB COMPUTATION
C     UPDATED  VERSION--AUGUST    2001. ADD IWRITE
C     UPDATED  VERSION--APRIL     2002. PRINTING OF GRAND MEAN
C     UPDATED  VERSION--OCTOBER   2002. SUPPORT FOR "CAPTURE HTML"
C     UPDATED  VERSION--OCTOBER   2003. SUPPORT FOR "CAPTURE LATEX"
C     UPDATED  VERSION--APRIL     2004. SOME MODIFICATIONS TO THE
C                                       FORMATTING OF THE OUTPUT
C     UPDATED  VERSION--MARCH     2006. SPLIT ROUTINE INTO MULTIPLE
C                                       SUBROUTINES
C     UPDATED  VERSION--MARCH     2006. IFORSW FOR SIGNIFICANT DIGITS
C     UPDATED  VERSION--MARCH     2006. REVISE OUTPUT FORMAT
C     UPDATED  VERSION--JUNE      2006. SET COMMANDS TO INDIVIDUALLY
C                                       CONTROL WHETHER A PARTICULAR
C                                       METHOD IS APPLIED
C     UPDATED  VERSION--JUNE      2006. OMIT LABS WITH ONLY ONE
C                                       OBSERVATION
C     UPDATED  VERSION--JUNE      2006. ADD THE BAYESIAN CONSENSUS
C                                       PROCEDURE METHOD OF HAGWOOD
C                                       AND GUTHRIE (A REFINEMENT OF
C                                       BOB)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IFORSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      LOGICAL IFLAG9
C
      REAL SIGMAH
      REAL XJUNK
      REAL APPF
      REAL XMP
      REAL XMPS
      REAL XMMPS
      REAL S2BMP
      REAL S2BMPS
      REAL S2BMMP
      REAL XML
      REAL XMLS
      REAL S2BML
      REAL S2BMLS
      REAL AMNX
      REAL AMXX
      REAL ASM
      REAL ASB
      REAL AKU
      REAL AKUK1
      REAL AKUK2
      REAL ATEMP
      REAL RIGHT
      REAL XGRAND
      REAL SW
      REAL S2WPOO
      REAL SEMP
      REAL SEMPK1
      REAL SEMPK2
      REAL SEML
      REAL SEMLK1
      REAL SEMLK2
      REAL SEMMP
      REAL SEMMP1
      REAL SEMMP2
      REAL SDGRAN
      REAL ASD2
      REAL ABIAS
      REAL XGD
      REAL XGDS2
      REAL XGCI
      REAL SET1
      REAL SET1K1
      REAL SET1K2
      REAL SET2
      REAL SET2K1
      REAL SET2K2
      REAL XSE
      REAL XSES2
      REAL SEGDK1
      REAL SEGDK2
      REAL SESUK1
      REAL SESUK2
      REAL XDL
      REAL XDLS2
      REAL SEDLK1
      REAL SEDLK2
      REAL SEGCI
      REAL XFW
      REAL XFWS2
      REAL SEFWK1
      REAL SEFWK2
      REAL XBCP
      REAL XBCPSE
      REAL XBCPK1
      REAL XBCPK2
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      CHARACTER*80 IFILE5
      CHARACTER*12 ISTAT5
      CHARACTER*12 IFORM5
      CHARACTER*12 IACCE5
      CHARACTER*12 IPROT5
      CHARACTER*12 ICURS5
      CHARACTER*4 IERRF5
      CHARACTER*4 IENDF5
      CHARACTER*4 IREWI5
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
      REAL AMEAN(*)
      REAL ASD(*)
C
      INTEGER N(*)
C
      REAL DAT(*)
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION T(*)
      DOUBLE PRECISION W(*)
      DOUBLE PRECISION THAT(*)
C
      COMMON /MPCOM/ T0, T1
C
      INCLUDE 'DPCOST.INC'
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
      IPTEMP=IPRINT
      IFLAG9=.TRUE.
C
      ISUBN1='DPMA'
      ISUBN2='N2  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NUMVAR,IFORSW
   52   FORMAT('NPTS,NUMVAR,IFORSW = ',2I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NPTS.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,101)
  101   FORMAT('***** ERROR IN CONSENSUS MEANS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,102)
  102   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE CONSENSUS',
     1         'MEANS ANALYSIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,103)
  103   FORMAT('      MUST BE AT LEAST 2; THE ENTERED NUMBER OF')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,104)NPTS
  104   FORMAT('      OF OBSERVATIONS HERE = ',I6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               **************************************************
C               **  STEP 1.1--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='MAN2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='MAN2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='MAN2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='MAN2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='MAN2'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGA3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
      IF(IFORSW.EQ.'E'.OR.IFORSW.EQ.'EXP'.OR.IFORSW.EQ.'EXPO')THEN
        NUMDIG=-99
      ELSEIF(IFORSW.EQ.'0')THEN
        NUMDIG=0
      ELSEIF(IFORSW.EQ.'1')THEN
        NUMDIG=1
      ELSEIF(IFORSW.EQ.'2')THEN
        NUMDIG=2
      ELSEIF(IFORSW.EQ.'3')THEN
        NUMDIG=3
      ELSEIF(IFORSW.EQ.'4')THEN
        NUMDIG=4
      ELSEIF(IFORSW.EQ.'5')THEN
        NUMDIG=5
      ELSEIF(IFORSW.EQ.'6')THEN
        NUMDIG=6
      ELSEIF(IFORSW.EQ.'7')THEN
        NUMDIG=7
      ELSEIF(IFORSW.EQ.'8')THEN
        NUMDIG=8
      ELSEIF(IFORSW.EQ.'9')THEN
        NUMDIG=9
      ELSEIF(IFORSW.EQ.'10')THEN
        NUMDIG=10
      ELSEIF(IFORSW.EQ.'11')THEN
        NUMDIG=11
      ELSEIF(IFORSW.EQ.'12')THEN
        NUMDIG=12
      ELSE
        NUMDIG=-99
      ENDIF
C               ***********************************************
C               **  STEP 2.1--                               **
C               **  IF TWO VARIABLES ENTERED, THEN           **
C               **     Y1 = RESPONSE VARIABLE                **
C               **     Y2 = LAB ID VARIABLE                  **
C               **  1) COPY RESPONSE DATA TO "DAT"           **
C               **  2) DETERMINE NUMBER OF DISTINCT LABS     **
C               **  3) SORT RESPONSE (DAT) BY LAB ID         **
C               **  4) DETERMINE NUMER OF POINTS IN EACH LAB **
C               ***********************************************
C
      IF(NUMVAR.EQ.3)GOTO6100
C
      CALL DPMAN3(Y1,Y2,Y3,NPTS,NUMVAR,NLAB,
     1DAT,X,T,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ASM,ASD2,
     1XGRAND,S2WPOO,SW,
     1AMNX,AMXX,
     1IWRITE,IOUNI1,
     1ICAPSW,ICAPTY,NUMDIG,
     1ISUBRO,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
C
C     FOLLOWING CALL NEEDED TO INITIALIZE MANDEL-PAULE
C     AND VANGEL-RUKHIN METHODS
C
      CALL MPPREP (NLAB, X, T, T0, T1)
C
C     MANDEL-PAULE
C
      IF(IMPACM.EQ.'ON')THEN
        CALL DPMNPL(Y1,Y2,Y3,NPTS,NLAB,
     1              X,T,N,
     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1              DLOWMP,DHIGMP,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     MODIFIED MANDEL-PAULE
C
      IF(IMMPCM.EQ.'ON')THEN
        CALL DPMMPL(Y1,Y2,Y3,NPTS,NLAB,
     1              X,T,N,
     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
     1              DLOWMM,DHIGMM,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     VANGEL-RUKHIN MAXIMUM LIKELIHOOD
C
      IF(IVRUCM.EQ.'ON')THEN
        CALL DPVRML(NPTS,NLAB,
     1              X,T,W,N,
     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
     1              DLOWML,DHIGML,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IOUNI5,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     BOB (BOUND ON BIAS)
C
      IF(IBOBCM.EQ.'ON')THEN
        CALL DPBOB(NPTS,NLAB,
     1             AMEAN,ASD,AMNX,AMXX,SW,
     1             ASM,ASB,AKU,AKUK1,AKUK2,
     1             DLOWBO,DHIGBO,STXMU,STS2B,
     1             IWRITE,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     SCHILLER-EBERHARDT
C
      IF(ISCECM.EQ.'ON')THEN
        CALL DPSCEB(Y1,Y2,Y3,NPTS,NLAB,
     1              W,N,
     1              AMEAN,ASD,S2BMPS,
     1              XSE,XSES2,IDFH,SIGMAH,
     1              SESUK1,SESUK2,
     1              DLOWSE,DHIGSE,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     MEAN OF MEANS
C
      IF(IMOMCM.EQ.'ON')THEN
        CALL DPMMEA(NPTS,NLAB,
     1              ASM,ASD2,SET2,SET2K1,SET2K2,
     1              DLOWT1,DHIGT1,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  GRAYBILL-DEAL
C
      IF(IGRDCM.EQ.'ON')THEN
        CALL DPGRAY(NPTS,NLAB,
     1              AMEAN,ASD,N,
     1              XGD,XGDS2,SEGDK1,SEGDK2,
     1              DLOWGD,DHIGGD,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     GRAND MEAN
C
      IF(IGMECM.EQ.'ON')THEN
        CALL DPGMEA(NPTS,NLAB,
     1              XGRAND,ASD2,SET1,SET1K1,SET1K2,
     1              DLOWT2,DHIGT2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  IYER-WANG GENERALIZED CONFIDENCE INTERVAL
C
      IF(IGCICM.EQ.'ON')THEN
        CALL DPGCI(NPTS,NLAB,
     1             AMEAN,ASD,N,
     1             T,W,
     1             XGCI,SEGCI,
     1             DLOWGC,DHIGGC,
     1             IWRITE,IOUNI5,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  DERSIMONIAN LAIRD
C
      IF(IDSLCM.EQ.'ON')THEN
        CALL DPDERS(NPTS,NLAB,
     1              AMEAN,ASD,N,
     1              XDL,XDLS2,SEDLK1,SEDLK2,
     1              DLOWDL,DHIGDL,DLOWD2,DHIGD2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  FAIRWEATHER
C
      IF(IFAICM.EQ.'ON')THEN
        CALL DPFAIR(NPTS,NLAB,
     1              AMEAN,ASD,N,
     1              XFW,XFWS2,SEFWK1,SEFWK2,
     1              DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IFLAG9,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
      IF(IBCPCM.EQ.'ON')THEN
        CALL DPBCP(NPTS,NLAB,
     1             AMEAN,ASD,N,AMNX,AMXX,
     1             XBCP,XBCPSE,XBCPK1,XBCPK2,
     1             DLOWBC,DHIGBC,
     1             IWRITE,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     CONFIDENCE LIMITS TABLE
C
      CALL DPMAN5(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XGCI,XDL,XFW,XBCP,
     1DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,
     1DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
     1DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
     1DLOWDL,DHIGDL,DLOWD2,DHIGD2,
     1DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1DLOWBC,DHIGBC,
     1IWRITE,IOUNI2,
     1ICAPSW,ICAPTY,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
C     STANDARD AND EXPANDED UNCERTAINTIES TABLE
C
      IK=1
      CALL DPMAN6(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XDL,XGCI,XFW,XBCP,
     1SEMPK1,SEMMP1,SEMLK1,AKUK1,SESUK1,SET1K1,
     1SET2K1,SEGDK1,SEDLK1,SEGCI,SEFWK1,XBCPK1,
     1IWRITE,
     1ICAPSW,ICAPTY,IK,IOUNI3,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
      IK=2
      CALL DPMAN6(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XDL,XGCI,XFW,XBCP,
     1SEMPK2,SEMMP2,SEMLK2,AKUK2,SESUK2,SET1K2,
     1SET2K2,SEGDK2,SEDLK2,2.0*SEGCI,SEFWK2,XBCPK2,
     1IWRITE,
     1ICAPSW,ICAPTY,IK,IOUNI4,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
      GOTO8000
C
C               ***********************************************
C               **  STEP 2.1--                               **
C               **  IF THREE VARIABLES ENTERED, THEN FIRST   **
C               **  VARIABLE IS LAB MEANS, SECOND VARIABLE IS**
C               **  LAB SD, AND THIRD VARIABLE IS NUMBER OF  **
C               **  OBSERVATIONS FOR LAB.                    **
C               ***********************************************
C
C
 6100 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      NLAB=NPTS
      IF(NLAB.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6211)
 6211   FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6212)
 6212   FORMAT('      FOR THE THREE VARIABLE SYNTAX OF THE CONSENSUS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6214)
 6214   FORMAT('      MEANS COMMAND, THERE MUST BE AT LEAST TWO LABS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,6220)
 6220   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NTOT=0
      DO6110I=1,NLAB
        N(I)=INT(Y3(I)+0.5)
        NTOT=NTOT+N(I)
 6110 CONTINUE
C
      CALL DPMAN4(Y1,Y2,Y3,NLAB,NTOT,
     1DAT,X,T,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ASM,ASD2,SDGRAN,
     1XGRAND,S2WPOO,SW,
     1AMNX,AMXX,
     1IWRITE,IOUNI1,
     1ICAPSW,ICAPTY,NUMDIG,
     1ISUBRO,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
C
CCCCC CALL MPPREP (NLAB, X, T, T0, T1)
C
      T0=AMNX
      T1=AMXX
      DO6120I=1,NLAB
        X(I)=(X(I)-T0)/(T1-T0)
        T(I)=T(I)/((T1-T0)**2)
 6120 CONTINUE
C
C
C     MANDEL-PAULE
C
      IF(IMPACM.EQ.'ON')THEN
        CALL DPMNPL(Y1,Y2,Y3,NTOT,NLAB,
     1              X,T,N,
     1              XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1              DLOWMP,DHIGMP,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     MODIFIED MANDEL-PAULE
C
      IF(IMMPCM.EQ.'ON')THEN
        CALL DPMMPL(Y1,Y2,Y3,NTOT,NLAB,
     1              X,T,N,
     1              XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
     1              DLOWMM,DHIGMM,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     VANGEL-RUKHIN MAXIMUM LIKELIHOOD
C
      IF(IVRUCM.EQ.'ON')THEN
        CALL DPVRML(NTOT,NLAB,
     1              X,T,W,N,
     1              XMLS,S2BMLS,SEML,SEMLK1,SEMLK2,
     1              DLOWML,DHIGML,STXMU,STS2B,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IOUNI5,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     BOB (BOUND ON BIAS)
C
      IF(IBOBCM.EQ.'ON')THEN
        CALL DPBOB(NTOT,NLAB,
     1             AMEAN,ASD,AMNX,AMXX,SW,
     1             ASM,ASB,AKU,AKUK1,AKUK2,
     1             DLOWBO,DHIGBO,STXMU,STS2B,
     1             IWRITE,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     SCHILLER-EBERHARDT
C
      IF(ISCECM.EQ.'ON')THEN
        CALL DPSCEB(Y1,Y2,Y3,NTOT,NLAB,
     1              W,N,
     1              AMEAN,ASD,S2BMPS,
     1              XSE,XSES2,IDFH,SIGMAH,
     1              SESUK1,SESUK2,
     1              DLOWSE,DHIGSE,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     MEAN OF MEANS
C
      IF(IMOMCM.EQ.'ON')THEN
        CALL DPMMEA(NTOT,NLAB,
     1              ASM,ASD2,SET2,SET2K1,SET2K2,
     1              DLOWT1,DHIGT1,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  GRAYBILL-DEAL
C
      IF(IGRDCM.EQ.'ON')THEN
        CALL DPGRAY(NTOT,NLAB,
     1              AMEAN,ASD,N,
     1              XGD,XGDS2,SEGDK1,SEGDK2,
     1              DLOWGD,DHIGGD,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     GRAND MEAN
C
      IF(IGMECM.EQ.'ON')THEN
        CALL DPGMEA(NTOT,NLAB,
     1              XGRAND,SDGRAN,SET1,SET1K1,SET1K2,
     1              DLOWT2,DHIGT2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  IYER-WANG GENERALIZED CONFIDENCE INTERVAL
C
      IF(IGCICM.EQ.'ON')THEN
        CALL DPGCI(NTOT,NLAB,
     1             AMEAN,ASD,N,
     1             T,W,
     1             XGCI,SEGCI,
     1             DLOWGC,DHIGGC,
     1             IWRITE,IOUNI5,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  DERSIMONIAN LAIRD
C
      IF(IDSLCM.EQ.'ON')THEN
        CALL DPDERS(NTOT,NLAB,
     1              AMEAN,ASD,N,
     1              XDL,XDLS2,SEDLK1,SEDLK2,
     1              DLOWDL,DHIGDL,DLOWD2,DHIGD2,
     1              IWRITE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C  FAIRWEATHER
C
      IF(IFAICM.EQ.'ON')THEN
        CALL DPFAIR(NTOT,NLAB,
     1              AMEAN,ASD,N,
     1              XFW,XFWS2,SEFWK1,SEFWK2,
     1              DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1              IWRITE,
     1              ICAPSW,ICAPTY,IFLAG9,
     1              ISUBRO,IBUGA3,IERROR)
      ENDIF
C
      IF(IBCPCM.EQ.'ON')THEN
        CALL DPBCP(NTOT,NLAB,
     1             AMEAN,ASD,N,AMNX,AMXX,
     1             XBCP,XBCPSE,XBCPK1,XBCPK2,
     1             DLOWBC,DHIGBC,
     1             IWRITE,
     1             ICAPSW,ICAPTY,
     1             ISUBRO,IBUGA3,IERROR)
      ENDIF
C
C     CONFIDENCE LIMITS TABLE
C
      CALL DPMAN5(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XGCI,XDL,XFW,XBCP,
     1DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,
     1DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
     1DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
     1DLOWDL,DHIGDL,DLOWD2,DHIGD2,
     1DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1DLOWBC,DHIGBC,
     1IWRITE,IOUNI2,
     1ICAPSW,ICAPTY,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
      IK=1
      CALL DPMAN6(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XDL,XGCI,XFW,XBCP,
     1SEMPK1,SEMMP1,SEMLK1,AKUK1,SESUK1,SET1K1,
     1SET2K1,SEGDK1,SEDLK1,SEGCI,SEFWK1,XBCPK1,
     1IWRITE,
     1ICAPSW,ICAPTY,IK,IOUNI3,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
      IK=2
      CALL DPMAN6(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XDL,XGCI,XFW,XBCP,
     1SEMPK2,SEMMP2,SEMLK2,AKUK2,SESUK2,SET1K2,
     1SET2K2,SEGDK2,SEDLK2,2.0*SEGCI,SEFWK2,XBCPK2,
     1IWRITE,
     1ICAPSW,ICAPTY,IK,IOUNI4,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
      GOTO8000
C
 8000 CONTINUE
C
C     RESET "ASIS" MODE
C
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
 5195   FORMAT('
')
        WRITE(ICOUT,5195)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
        CALL DPCONA(92,IBASLC)
 8190   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8190)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ENDIF
C
C     CLOSE OUTPUT FILES
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      IENDF5='OFF'
      IREWI5='ON'
      CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGA3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
C     DESCRIBE OUTPUT TO TEMPORARY OUTPUT FILES
C
      IF(IFEEDB.EQ.'OFF')GOTO8099
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')GOTO8099
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')GOTO8099
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')GOTO8099
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')GOTO8099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8002)
 8002 FORMAT('Automatic Output:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8005)
 8005 FORMAT('The following variables were written to the file ',
     1       'dpst1f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('   1. Lab ID')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8021)
 8021 FORMAT('   2. Number of Observations for Lab')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8031)
 8031 FORMAT('   3. Mean of Lab')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8041)
 8041 FORMAT('   4. Variance of Lab')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8051)
 8051 FORMAT('   5. Standard Deviation of Lab')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8054)
 8054 FORMAT('   6. Standard Deviation of Mean of Lab')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8056)
 8056 FORMAT('The following variables were written to the file ',
     1       'dpst2f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8058)
 8058 FORMAT('   1. Consensus Means from the Various Methods')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8060)
 8060 FORMAT('   2. Lower 95% Confidence Limit from the ',
     1       'Various Methods')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8062)
 8062 FORMAT('   3. Upper 95% Confidence Limit from the ',
     1       'Various Methods')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8064)
 8064 FORMAT('The following variables were written to the file ',
     1       'dpst3f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8058)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8066)
 8066 FORMAT('   2. Standard Uncertainty (k=1) for the Various ',
     1       'Methods')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8068)
 8068 FORMAT('   3. Relative Standard (k=1) Uncertainty ',
     1       '(100*Consensus Mean/Standard Uncertainty)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8070)
 8070 FORMAT('The following variables were written to the file ',
     1       'dpst4f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8058)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8072)
 8072 FORMAT('   2. Expanded Uncertainty (k=2) for the Various ',
     1       'Methods')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8074)
 8074 FORMAT('   3. Relative Expanded (k=2) Uncertainty ',
     1       '(100*Consensus Mean/Expanded Uncertainty)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,8075)
 8075 FORMAT('The following variables were written to the file ',
     1       'dpst5f.dat:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8081)
C8081 FORMAT('   1. Maximum Likelihood Weights')
 8081 FORMAT('   1. Consensus Means from Generalized Confidence ',
     1       'Interval Simulations')
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,8083)
C8083 FORMAT('   2. Estimate of Tau for Maximum Likelihood')
CCCCC CALL DPWRST('XXX','BUG ')
C
 8099 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMAN2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NUMVAR,NLAB
 9013   FORMAT('NPTS,NUMVAR,NLAB = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IBUGA3
 9014   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMAN3(Y1,Y2,Y3,NPTS,NUMVAR,NLAB,
     1DAT,X,T,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ASM,ASD2,
     1XGRAND,S2WPOO,SW,
     1AMNX,AMXX,
     1IWRITE,IOUNI1,
     1ICAPSW,ICAPTY,NUMDIG,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE INITIAL SUMMARY TABLES FOR CONSENSUS MEANS
C              COMMAND (FULL DATA CASE).
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
C
      CHARACTER*1 IBASLC
      CHARACTER*20 IFORMT
C
      REAL ATEMP
      REAL RIGHT
      REAL XGRAND
      REAL SW
      REAL S2WPOO
      REAL SDGRAN
      REAL AMNX
      REAL AMXX
      REAL ASM
      REAL ASD2
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
      REAL AMEAN(*)
      REAL ASD(*)
C
      INTEGER N(*)
C
      REAL DAT(*)
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION T(*)
C
      COMMON /MPCOM/ T0, T1
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMA'
      ISUBN2='N3  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN3')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAN3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NUMVAR
   52   FORMAT('NPTS,NUMVAR = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ***********************************************
C               **  STEP 2.1--                               **
C               **  COMPUTE OVERALL STATISTICS AND COMPUTE   **
C               **  NUMBER OF DISTINCT LABS.                 **
C               **  IF TWO VARIABLES ENTERED, THEN           **
C               **     Y1 = RESPONSE VARIABLE                **
C               **     Y2 = LAB ID VARIABLE                  **
C               **  1) COPY RESPONSE DATA TO "DAT"           **
C               **  2) DETERMINE NUMBER OF DISTINCT LABS     **
C               **  3) SORT RESPONSE (DAT) BY LAB ID         **
C               ***********************************************
C
      CALL MEAN(Y1,NPTS,IWRITE,XGRAND,IBUGA3,IERROR)
      CALL SD(Y1,NPTS,IWRITE,SDGRAN,IBUGA3,IERROR)
      CALL SORTC(Y2,Y1,NPTS,Y2,DAT)
      CALL DISTIN(Y2,NPTS,IWRITE,Y3,NLAB,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
      IF(NLAB.LT.2 .OR. NLAB.GE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,211)
  211   FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,212)
  212   FORMAT('      FOR THE TWO VARIABLE SYNTAX OF THE CONSENSUS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,214)
  214   FORMAT('      MEANS COMMAND, THE SECOND VARIABLE IS THE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,216)
  216   FORMAT('      LAB ID VARIABLE.  THE NUMBER OF LABS SHOULD')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,218)
  218   FORMAT('      BE AT LEAST 2 AND LESS THAN THE NUMBER OF')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,220)
  220   FORMAT('      POINTS.  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,222)NLAB
  222   FORMAT('      NUMBER OF UNIQUE LAB IDS = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,224)NPTS
  224   FORMAT('      TOTAL NUMBER OF POINTS   = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ***********************************************
C               **  STEP 2.2--                               **
C               **  COMPUTE THE SUMMARY STATISTICS BY LAB    **
C               **  1) DETERMINE NUMER OF POINTS IN EACH LAB **
C               **  2) MEAN FOR EACH LAB                     **
C               **  3) SD FOR EACH LAB                       **
C               ***********************************************
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO250I=1,NLAB
        ATEMP=Y3(I)
        N(I)=0
        DO259J=1,NPTS
          IF(Y2(J).EQ.ATEMP)THEN
            N(I)=N(I)+1
            Y1(N(I))=DAT(J)
          ENDIF
  259   CONTINUE
C
        IF(N(I).EQ.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,211)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,254)Y3(I)
  254     FORMAT('      LAB ',F10.5,' HAS NO DATA')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        CALL MEAN(Y1,N(I),IWRITE,RIGHT,IBUGA3,IERROR)
        X(I)=DBLE(RIGHT)
        AMEAN(I)=RIGHT
        IF(AMEAN(I).LT.AMNX)AMNX=AMEAN(I)
        IF(AMEAN(I).GT.AMXX)AMXX=AMEAN(I)
        CALL SD(Y1,N(I),IWRITE,ASD(I),IBUGA3,IERROR)
C
        IF(ASD(I).LE.0.0)THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,211)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,264)Y3(I)
CC264     FORMAT('      LAB ',F10.5,' HAS A NON-POSITIVE ',
CCCCC1           'STANDARD DEVIATION.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,266)
CC266     FORMAT('      THIS HAPPENS IF THE LAB HAS A SINGLE ',
CCCCC1           'DATA POINT')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,267)
CC267     FORMAT('      OR IF ALL THE DATA POINTS HAVE THE SAME ',
CCCCC1           'VALUE.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,269)
CC269     FORMAT('      RE-RUN THE CONSENSUS MEANS ANALYSIS WITH ',
CCCCC1           'THIS LAB OMITTED.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     IERROR='YES'
CCCCC     GOTO9000
CCCCC   ENDIF
C
        ELSE
          IF(ASD(I).LT.AMNSD)AMNSD=ASD(I)
          IF(ASD(I).GT.AMXSD)AMXSD=ASD(I)
        ENDIF
C
        CALL SDMEAN(Y1,N(I),IWRITE,RIGHT,IBUGA3,IERROR)
        T(I)=DBLE(RIGHT**2)
C
  250 CONTINUE
C
      CALL MEAN(AMEAN,NLAB,IWRITE,ASM,IBUGA3,IERROR)
      CALL SD(AMEAN,NLAB,IWRITE,ASD2,IBUGA3,IERROR)
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
C
      DO270J=1,NLAB
        DTERM1=DBLE(N(J)-1.0D0)
        DSUM2=DSUM2 + DTERM1*(DBLE(ASD(J))**2)
        DSUM3=DSUM3 + DTERM1
        DTERM1=DBLE(N(J))
        DSUM1=DSUM1 + DBLE(ASD(J))**2/DTERM1
  270 CONTINUE
C
      DTEMP=DSQRT(DSUM1)/DBLE(NLAB)
      S2WPOO=DSUM2/DSUM3
      SW=REAL(DTEMP)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5102)
C5102   FORMAT('
Consensus Mean Analysis
')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5103)
C5103   FORMAT('(Full Sample Case)

')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','WRIT')
C
 5107   FORMAT('
    ')
 5111   FORMAT('')
 5113   FORMAT('   ')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5114)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
 5114   FORMAT('      Consensus Mean Analysis
    ')
 5115   FORMAT('      (Full Sample Case)    ')
 5119   FORMAT('   
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5193   FORMAT('
')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
 5135   FORMAT('         Summary Statistics:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
 5136   FORMAT('         Response Variable:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)IHLEFT,IHLEF2
 5137   FORMAT('         ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5140)
 5140   FORMAT('         Lab-ID Variable:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)IHRIGH,IHRIG2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         Total Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)NPTS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         Grand Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGRAND
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5143)
 5143   FORMAT('         Grand Standard Deviation:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SDGRAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         Total Number of Labs:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)NLAB
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5164)
 5164   FORMAT('         Minimum Lab Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMNX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5165)
 5165   FORMAT('         Maximum Lab Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMXX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
 5166   FORMAT('         Minimum Lab SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMNSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5167)
 5167   FORMAT('         Maximum Lab SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMXSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         Within Lab (pooled) SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SQRT(S2WPOO)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         Within Lab (pooled) Variance:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2WPOO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 5211   FORMAT('')
 5222   FORMAT('      ')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
 5215   FORMAT('      Table 1: Summary Statistics By Lab')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5222)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5231)
 5231   FORMAT('         Lab ID')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5222)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5232)
 5232   FORMAT('         n(i)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5233)
 5233   FORMAT('         Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5234)
 5234   FORMAT('         Variance')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5235)
 5235   FORMAT('         Standard
Deviation')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5236)
 5236   FORMAT('         Standard Deviation
of the Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
 5326   FORMAT('      ')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5231)
 5231   FORMAT('         Lab ID')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5222)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5232)
 5232   FORMAT('         n(I)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5222)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5233)
 5233   FORMAT('         Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5234)
 5234   FORMAT('         Variance')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5235)
 5235   FORMAT('         Standard
Deviation')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5236)
 5236   FORMAT('         Standard Deviation
of the Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
 5225   FORMAT('      ')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5223)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
 5131   FORMAT('         Method')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5226)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
 5132   FORMAT('         Consensus
Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5226)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
 5133   FORMAT('         Lower
Limit')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5226)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
 5134   FORMAT('         Upper
Limit')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        IFORMT='(9X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(9:9),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(9X,E15.7)'
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='1. Mandel-Paule'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='2. Modified Mandel-Paule'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWMM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGMM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='3. Vangel-Rukhin ML'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMLS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWML
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGML
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='4. BOB'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWBO
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGBO
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='5. Schiller-Eberhardt'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='6. Mean of Means'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWT1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGT1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='7. Graybill-Deal'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWGD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGGD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='8. Grand Mean'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGRAND
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWT2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGT2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='9. Generalized CI'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGCI
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWGC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGGC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='10. DerSimonian-Laird (t)'
          WRITE(ICOUT,5143)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5144   FORMAT('              ',
     1         'DerSimonian-Laird (Ruhkin)')
        IF(IDSLCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5144)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWD2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGD2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='11. Fairweather'
          WRITE(ICOUT,5143)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XFAIR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWF2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGF2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
 5146     FORMAT('              ',
     1           'Fairweather (Cox)')
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5146)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XFAIR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWF3
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGF3
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
 5147     FORMAT('              ',
     1           'Fairweather (Ruhkin)')
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XFAIR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWFW
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGFW
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
 5149   FORMAT('12. BCP')
        IF(IBCPCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='12. BCP'
          WRITE(ICOUT,5143)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XBCP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DLOWBC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)DHIGBC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5195)
CCCCC   CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
        CALL DPCONA(39,IQUOTE)
C
C8001   FORMAT(A1,'end{verbatim}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT('{',A1,'bf Table 2: 95',A1,'% Confidence Limits}')
 8004   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8005   FORMAT(A1,'begin{center}')
CCCCC   WRITE(ICOUT,8001)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8142 FORMAT(5X,A1,'begin{tabular} {|l|c|c|c|}')
 8143 FORMAT(5X,A1,'hline')
 8144 FORMAT(5X,' & Consensus & Lower & ', 'Upper ',A1,A1)
 8145 FORMAT(5X,'Method & Mean & Limit & ','Limit ',A1,A1)
        WRITE(ICOUT,8142)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8144)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8145)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C8151   FORMAT(5X,'1. Mandel-Paule ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8152   FORMAT(5X,'2. Modified Mandel-Paule ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8153   FORMAT(5X,'3. Vangel-Rukhin ML ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8154   FORMAT(5X,'4. BOB ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8155   FORMAT(5X,'5. Schiller-Eberhardt ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8156   FORMAT(5X,'6. Mean of Means ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8157   FORMAT(5X,'7. Graybill-Deal ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8158   FORMAT(5X,'8. Grand Mean (T) ',3(' & ',F15.7),
C    1         2X,A1,A1)
C
        IFORMT='(5X,A25,3( &  ,F15.7),2X,A1,A1)'
        IFORMT(11:11)=IQUOTE
        IFORMT(14:14)=IQUOTE
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(20:20),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(5X,A25,3( &  ,E15.7),2X,A1,A1)'
          IFORMT(11:11)=IQUOTE
          IFORMT(14:14)=IQUOTE
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          IMETH='1. Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMPS,DLOWMP,DHIGMP,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          IMETH='2. Modified Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMMPS,DLOWMM,DHIGMM,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          IMETH='3. Vangel-Rukhin ML'
          WRITE(ICOUT,IFORMT)IMETH,XMLS,DLOWML,DHIGML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          IMETH='4. BOB'
          WRITE(ICOUT,IFORMT)IMETH,ASM,DLOWBO,DHIGBO,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          IMETH='5. Schiller-Eberhardt'
          WRITE(ICOUT,IFORMT)IMETH,XSE,DLOWSE,DHIGSE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          IMETH='6. Mean of Means'
          WRITE(ICOUT,IFORMT)IMETH,ASM,DLOWT1,DHIGT1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          IMETH='7. Graybill Deal'
          WRITE(ICOUT,IFORMT)IMETH,XGD,DLOWGD,DHIGGD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          IMETH='8. Grand Mean'
          WRITE(ICOUT,IFORMT)IMETH,XGRAND,DLOWT2,DHIGT2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          IMETH='9. Generalized CI'
          WRITE(ICOUT,IFORMT)IMETH,XGCI,DLOWGC,DHIGGC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          IMETH='10. DerSimonian-Laird (t)'
          WRITE(ICOUT,IFORMT)IMETH,XDL,DLOWDL,DHIGDL,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
C
          IMETH='    (Rukhin)'
          WRITE(ICOUT,IFORMT)IMETH,XDL,DLOWD2,DHIGD2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
          IMETH='11. Fairweather (Fairweather)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWF2,DHIGF2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
C
          IMETH='    (Cox)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWF3,DHIGF3,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
C
          IMETH='    (Rukhin)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWFW,DHIGFW,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBCPCM.EQ.'ON')THEN
          IMETH='12. BCP'
          WRITE(ICOUT,IFORMT)IMETH,XBCP,DLOWBC,DHIGBC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
 8043   FORMAT(5X,A1,'hline')
C8190   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8190)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  TABLE 2
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=30
        IHEAD(1:NHEAD)='Table 2: 95% Confidence Limits'
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*3800/IDEFPS
        IINC1=IRTFPS*1700/IDEFPS
CCCCC   IINC2=IRTFPS*2000/IDEFPS
C
        DO6005ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6005   CONTINUE
        ALIGN(1)='l'
C
        IWIDTH(1)=IFRST
        DO6008I=2,NCOL
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6008   CONTINUE
C
        IVALUE(1)=' b Method'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
C
        IVALUE(2)=' b Consensus line Mean'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(13:13)=IBASLC
        NCHAR(2)=22
C
        IVALUE(3)=' b Lower line Limit'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(9:9)=IBASLC
        NCHAR(3)=19
C
        IVALUE(4)=' b Upper line Limit'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(9:9)=IBASLC
        NCHAR(4)=19
C
        NHEAD=NCOL
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=3
C
        IF(IMPACM.EQ.'ON')THEN
          NCHAR(1)=16
          IVALUE(1)=' 1. Mandel-Paule'
          AVALUE(2)=XMPS
          AVALUE(3)=REAL(DLOWMP)
          AVALUE(4)=REAL(DHIGMP)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          NCHAR(1)=25
          IVALUE(1)=' 2. Modified Mandel-Paule'
          AVALUE(2)=XMMPS
          AVALUE(3)=REAL(DLOWMM)
          AVALUE(4)=REAL(DHIGMM)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          NCHAR(1)=20
          IVALUE(1)=' 3. Vangel-Rukhin ML'
          AVALUE(2)=XMLS
          AVALUE(3)=REAL(DLOWML)
          AVALUE(4)=REAL(DHIGML)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          NCHAR(1)=7
          IVALUE(1)=' 4. BOB'
          AVALUE(2)=ASM
          AVALUE(3)=REAL(DLOWBO)
          AVALUE(4)=REAL(DHIGBO)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          NCHAR(1)=22
          IVALUE(1)=' 5. Schiller-Eberhardt'
          AVALUE(2)=XSE
          AVALUE(3)=REAL(DLOWSE)
          AVALUE(4)=REAL(DHIGSE)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          NCHAR(1)=17
          IVALUE(1)=' 6. Mean of Means'
          AVALUE(2)=ASM
          AVALUE(3)=REAL(DLOWT1)
          AVALUE(4)=REAL(DHIGT1)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          NCHAR(1)=17
          IVALUE(1)=' 7. Graybill-Deal'
          AVALUE(2)=XGD
          AVALUE(3)=REAL(DLOWGD)
          AVALUE(4)=REAL(DHIGGD)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          NCHAR(1)=14
          IVALUE(1)=' 8. Grand Mean'
          AVALUE(2)=XGRAND
          AVALUE(3)=REAL(DLOWT2)
          AVALUE(4)=REAL(DHIGT2)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          NCHAR(1)=18
          IVALUE(1)=' 9. Generalized CI'
          AVALUE(2)=XGCI
          AVALUE(3)=REAL(DLOWGC)
          AVALUE(4)=REAL(DHIGGC)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          NCHAR(1)=25
          IVALUE(1)='10. DerSimonian-Laird (t)'
          AVALUE(2)=XDL
          AVALUE(3)=REAL(DLOWDL)
          AVALUE(4)=REAL(DHIGDL)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
          NCHAR(1)=30
          IVALUE(1)='    DerSimonian-Laird (Rukhin)'
          AVALUE(2)=XDL
          AVALUE(3)=REAL(DLOWD2)
          AVALUE(4)=REAL(DHIGD2)
          IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
          NCHAR(1)=29
          IVALUE(1)='11. Fairweather (Fairweather)'
          AVALUE(2)=XFAIR
          AVALUE(3)=REAL(DLOWF2)
          AVALUE(4)=REAL(DHIGF2)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
          NCHAR(1)=22
          IVALUE(1)='    Fairweather (Cox)'
          AVALUE(2)=XDL
          AVALUE(3)=REAL(DLOWD3)
          AVALUE(4)=REAL(DHIGD3)
          IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
          NCHAR(1)=25
          IVALUE(1)='    Fairweather (Ruhkin)'
          AVALUE(2)=XDL
          AVALUE(3)=REAL(DLOWFW)
          AVALUE(4)=REAL(DHIGFW)
          IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IBCPCM.EQ.'ON')THEN
          NCHAR(1)=7
          IVALUE(1)='12. BCP'
          AVALUE(2)=XBCP
          AVALUE(3)=REAL(DLOWBC)
          AVALUE(4)=REAL(DHIGBC)
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('Table 2:  95% Confidence Limits')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)
 4011   FORMAT(
     1'                               Consensus            Lower',
     1'            Upper')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)
 4012 FORMAT(
     1'Method                              Mean            Limit',
     1'            Limit')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4015)
 4015   FORMAT(
     1'------------------------------------------------------',
     1'--------------------')
        CALL DPWRST('XXX','WRIT')
C
C4065   FORMAT(A25,F15.7,2X,F15.7,2X,F15.7)
 4095   FORMAT(3(E15.7,2X),A25)
C
        IFORMT=' '
        IFORMT='(A25,F15.7,2X,F15.7,2X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(10:10),'(I1)')NUMDIG
          WRITE(IFORMT(19:19),'(I1)')NUMDIG
          WRITE(IFORMT(28:28),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(A25,E15.7,2X,E15.7,2X,E15.7)'
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          IMETH=' 1. Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMPS,DLOWMP,DHIGMP
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IMMPCM.EQ.'ON')THEN
          IMETH=' 2. Modified Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMMPS,DLOWMM,DHIGMM
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IVRUCM.EQ.'ON')THEN
          IMETH=' 3. Vangel-Rukhin ML'
          WRITE(ICOUT,IFORMT)IMETH,XMLS,DLOWML,DHIGML
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IBOBCM.EQ.'ON')THEN
          IMETH=' 4. BOB'
          WRITE(ICOUT,IFORMT)IMETH,ASM,DLOWBO,DHIGBO
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(ISCECM.EQ.'ON')THEN
          IMETH=' 5. Schiller-Eberhardt'
          WRITE(ICOUT,IFORMT)IMETH,XSE,DLOWSE,DHIGSE
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IMOMCM.EQ.'ON')THEN
          IMETH=' 6. Mean of Means'
          WRITE(ICOUT,IFORMT)IMETH,ASM,DLOWT1,DHIGT1
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGRDCM.EQ.'ON')THEN
          IMETH=' 7. Graybill-Deal'
          WRITE(ICOUT,IFORMT)IMETH,XGD,DLOWGD,DHIGGD
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGMECM.EQ.'ON')THEN
          IMETH=' 8. Grand Mean'
          WRITE(ICOUT,IFORMT)IMETH,XGRAND,DLOWT2,DHIGT2
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGCICM.EQ.'ON')THEN
          IMETH=' 9. Generalized CI'
          WRITE(ICOUT,IFORMT)IMETH,XGCI,DLOWGC,DHIGGC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IDSLCM.EQ.'ON')THEN
          IMETH='10. DerSimonian-Laird (t)'
          WRITE(ICOUT,IFORMT)IMETH,XDL,DLOWDL,DHIGDL
          CALL DPWRST('XXX','WRIT')
          IMETH='    (Rukhin)'
          WRITE(ICOUT,IFORMT)IMETH,XDL,DLOWD2,DHIGD2
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
          IMETH='11. Fairweather (Fairweather)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWF2,DHIGF2
          CALL DPWRST('XXX','WRIT')
          IMETH='    (Cox)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWF3,DHIGF3
          CALL DPWRST('XXX','WRIT')
          IMETH='    (Rukhin)'
          WRITE(ICOUT,IFORMT)IMETH,XFAIR,DLOWFW,DHIGFW
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBCPCM.EQ.'ON')THEN
          IMETH='12. BCP'
          WRITE(ICOUT,IFORMT)IMETH,XBCP,DLOWBC,DHIGBC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,4015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      IF(IMPACM.EQ.'ON')THEN
        IMETH='1. Mandel-Paule'
        WRITE(IOUNI2,4095)XMPS,DLOWMP,DHIGMP,IMETH
      ENDIF
      IF(IMMPCM.EQ.'ON')THEN
        IMETH='2. Modified Mandel-Paule'
        WRITE(IOUNI2,4095)XMMPS,DLOWMM,DHIGMM,IMETH
      ENDIF
      IF(IVRUCM.EQ.'ON')THEN
        IMETH='3. Vangel-Rukhin ML'
        WRITE(IOUNI2,4095)XMLS,DLOWML,DHIGML,IMETH
      ENDIF
      IF(IBOBCM.EQ.'ON')THEN
        IMETH='4. BOB'
        WRITE(IOUNI2,4095)ASM,DLOWBO,DHIGBO,IMETH
      ENDIF
      IF(ISCECM.EQ.'ON')THEN
        IMETH='5. Schiller-Eberhardt'
        WRITE(IOUNI2,4095)XSE,DLOWSE,DHIGSE,IMETH
      ENDIF
      IF(IMOMCM.EQ.'ON')THEN
        IMETH='6. Mean of Means'
        WRITE(IOUNI2,4095)ASM,DLOWT1,DHIGT1,IMETH
      ENDIF
      IF(IGRDCM.EQ.'ON')THEN
        IMETH='7. Graybill-Deal'
        WRITE(IOUNI2,4095)XGD,DLOWGD,DHIGGD,IMETH
      ENDIF
      IF(IGMECM.EQ.'ON')THEN
        IMETH='8. Grand Mean'
        WRITE(IOUNI2,4095)XGRAND,DLOWT2,DHIGT2,IMETH
      ENDIF
      IF(IGCICM.EQ.'ON')THEN
        IMETH='9. Generalized GCI'
        WRITE(IOUNI2,4095)XGCI,DLOWGC,DHIGGC,IMETH
      ENDIF
      IF(IDSLCM.EQ.'ON')THEN
        IMETH='10. DerSimonian-Laird (t)'
        WRITE(IOUNI2,4095)XDL,DLOWDL,DHIGDL,IMETH
        IMETH='    (Rukhin)'
        WRITE(IOUNI2,4095)XDL,DLOWD2,DHIGD2,IMETH
      ENDIF
      IF(IFAICM.EQ.'ON')THEN
        IMETH='11. Fairweather (Fairweather)'
        WRITE(IOUNI2,4095)XFAIR,DLOWF2,DHIGF2,IMETH
        IMETH='    (Cox)'
        WRITE(IOUNI2,4095)XFAIR,DLOWF3,DHIGF3,IMETH
        IMETH='    (Rukhin)'
        WRITE(IOUNI2,4095)XFAIR,DLOWFW,DHIGFW,IMETH
      ENDIF
      IF(IBCPCM.EQ.'ON')THEN
        IMETH='12. BCP'
        WRITE(IOUNI2,4095)XBCP,DLOWBC,DHIGBC,IMETH
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN5')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMAN5--')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMAN6(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XDL,XGCI,XFAIR,XBCP,
     1SEMPK1,SEMMP1,SEMLK1,AKUK1,SESUK1,SET2K1,
     1SET1K1,SEGDK1,SEDLK1,SEGCI,SEFWK1,XBCPK1,
     1IWRITE,
     1ICAPSW,ICAPTY,IK,IOUNIT,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE THE STANDARD AND EXPANDED UNCERTAINTY
C              TABLE FOR THE CONSENSUS MEANS COMMAND
C              (CALLED TWICE: ONCE FOR K = 1 AND ONCE FOR K = 2)
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2
C                                       ROUTINE
C     UPDATED         --JUNE      2006. USER CAN SELECT WHICH
C                                       METHODS ARE APPLIED
C     UPDATED         --JUNE      2006. ADD FAIRWEATHER AND BCP
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
      CHARACTER*1 IQUOTE
C
      CHARACTER*8  IUNCT
      CHARACTER*25 IMETH
      CHARACTER*40 IFORMT
C
      LOGICAL IFLAG9
C
      REAL XMP
      REAL XMPS
      REAL XMMPS
      REAL XML
      REAL XMLS
      REAL ASM
      REAL XGRAND
      REAL XGD
      REAL XDL
      REAL XGCI
      REAL XSE
      REAL SEMPK1
      REAL SEMMP1
      REAL SEMLK1
      REAL SEGCI
      REAL AKUK1
      REAL SESUK1
      REAL SET2K1
      REAL SET1K1
      REAL SEGDK1
      REAL SEDLK1
      REAL XFAIR
      REAL SEFWK1
      REAL XBCP
      REAL XBCPK1
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*50 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMA'
      ISUBN2='N2  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN6')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAN6--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IK.EQ.1)THEN
        IUNCT='Standard'
      ELSE
        IUNCT='Expanded'
      ENDIF
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
 5107   FORMAT('
    ')
 5111   FORMAT('
')
 5223   FORMAT('      ')
 5227   FORMAT('      ')
 5327   FORMAT('      ')
        IFORMT='(9X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(9:9),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(9X,E15.7)'
        ENDIF
C
        DO5240I=1,NLAB
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5326)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)INT(Y3(I))
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5326)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)N(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5327)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)X(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5327)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASD(I)**2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5327)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASD(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5327)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SQRT(T(I))
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
 5240   CONTINUE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8001   FORMAT(A1,'end{verbatim}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT('{',A1,'bf Consensus Mean Analysis}')
 8004   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
 8007   FORMAT('{',A1,'bf (Full Sample Case)}')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf Data Summary:} & ',2X,A1,A1)
 8012   FORMAT(5X,'Response Variable: & ',A4,A4,2X,A1,A1)
 8013   FORMAT(5X,'Lab-ID Variable: & ',A4,A4,2X,A1,A1)
 8014   FORMAT(5X,'Total Number of Observations: & ',I8,2X,A1,A1)
 8015   FORMAT(5X,'Grand Mean: & ',F15.7,2X,A1,A1)
 8016   FORMAT(5X,'Grand Standard Deviation: & ',F15.7,2X,A1,A1)
 8017   FORMAT(5X,'Total Number of Labs: & ',I8,2X,A1,A1)
 8018   FORMAT(5X,'Minimum Lab Mean:  &  ',F15.7,2X,A1,A1)
 8019   FORMAT(5X,'Maximum Lab Mean:  &  ',F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Minimum Lab SD:  &  ',F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Maximum Lab SD:  &  ',F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Within Lab (Pooled) SD:  &  ',F15.7,2X,A1,A1)
 8023   FORMAT(5X,'Within Lab (Pooled) Variance:  &  ',
     1         F15.7,2X,A1,A1)

        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)IHLEFT,IHLEF2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IHRIGH,IHRIG2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)NPTS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8015)XGRAND,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8016)SDGRAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)NLAB,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8018)AMNX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)AMXX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)AMNSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)AMXSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)SQRT(S2WPOO),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)S2WPOO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8040   FORMAT(5X,'{',A1,'bf Table 1: Summary Statistics by Lab}')
 8041   FORMAT(5X,A1,'begin{tabular} {|c|c|c|c|c|c|}')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8043   FORMAT(5X,A1,'hline')
 8044   FORMAT(5X,' & &  &  & Standard  & Standard Deviation ',A1,A1)
 8045   FORMAT(5X,'Lab ID & N(I) & Mean & Variance & ',
     1         'Deviation & of the Mean ',A1,A1)
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        DO8050I=1,NLAB
C
          IF(NUMDIG.EQ.1)THEN
            WRITE(ICOUT,8051)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8051      FORMAT(5X,I5,' & ',I8,' & ',F15.1,' & ',F15.1,' & ',
     1            F15.1,' & ',F15.1,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.2)THEN
            WRITE(ICOUT,8052)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8052      FORMAT(5X,I5,' & ',I8,' & ',F15.2,' & ',F15.2,' & ',
     1            F15.2,' & ',F15.2,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.3)THEN
            WRITE(ICOUT,8053)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8053      FORMAT(5X,I5,' & ',I8,' & ',F15.3,' & ',F15.3,' & ',
     1            F15.3,' & ',F15.3,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.4)THEN
            WRITE(ICOUT,8054)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8054      FORMAT(5X,I5,' & ',I8,' & ',F15.4,' & ',F15.4,' & ',
     1            F15.4,' & ',F15.4,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.5)THEN
            WRITE(ICOUT,8055)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8055      FORMAT(5X,I5,' & ',I8,' & ',F15.5,' & ',F15.5,' & ',
     1            F15.5,' & ',F15.5,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.6)THEN
            WRITE(ICOUT,8056)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8056      FORMAT(5X,I5,' & ',I8,' & ',F15.6,' & ',F15.6,' & ',
     1            F15.6,' & ',F15.6,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.7)THEN
            WRITE(ICOUT,8057)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8057      FORMAT(5X,I5,' & ',I8,' & ',F15.7,' & ',F15.7,' & ',
     1            F15.7,' & ',F15.7,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.8)THEN
            WRITE(ICOUT,8058)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8058      FORMAT(5X,I5,' & ',I8,' & ',F15.8,' & ',F15.8,' & ',
     1            F15.8,' & ',F15.8,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.9)THEN
            WRITE(ICOUT,8059)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8059      FORMAT(5X,I5,' & ',I8,' & ',F15.9,' & ',F15.9,' & ',
     1            F15.9,' & ',F15.9,2X,A1,A1)
          ELSEIF(NUMDIG.GE.10)THEN
            WRITE(ICOUT,8060)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8060      FORMAT(5X,I5,' & ',I8,' & ',E15.7,' & ',E15.7,' & ',
     1            E15.7,' & ',E15.7,2X,A1,A1)
          ELSE
            WRITE(ICOUT,8061)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8061      FORMAT(5X,I5,' & ',I8,' & ',F15.7,' & ',F15.7,' & ',
     1            F15.7,' & ',F15.7,2X,A1,A1)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8050   CONTINUE
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  WRITE HEADER LINE
C
 6193   FORMAT(A1,'fs',I1)
 6195   FORMAT(A1,'fs',I2)
        ITEMP2=INT(REAL(IRTFPS)*1.5)
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSEIF(ITEMP2.LE.99)THEN
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          ITEMP2=99
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IRTFMD='OFF'
        IFLAG1=.TRUE.
        IHEAD(1:37)=' b           Consensus Means Analysis'
        IHEAD(38:75)=' line               (Full Sample Case)'
        IHEAD(1:1)=IBASLC
        IHEAD(38:38)=IBASLC
        NHEAD=75
        CALL DPRTF8(IHEAD,NHEAD,ITEMP,IFLAG1)
        NHEAD=0
C
        ITEMP2=IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSEIF(ITEMP2.LE.99)THEN
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          ITEMP2=99
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  SUMMARY INFORMATION
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*3500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b Data Summary:'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=16
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='Response Variable:'
        NCHAR(1)=18
        IVALUE(2)(1:4)=IHLEFT(1:4)
        IVALUE(2)(5:8)=IHLEF2(1:4)
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='Lab-ID Variable:'
        NCHAR(1)=16
        IVALUE(2)(1:4)=IHRIGH(1:4)
        IVALUE(2)(5:8)=IHRIG2(1:4)
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=29
        IVALUE(1)='Total Number of Observations:'
        AVALUE(2)=REAL(NPTS)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=11
        IVALUE(1)='Grand Mean:'
        AVALUE(2)=XGRAND
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=25
        IVALUE(1)='Grand Standard Deviation:'
        AVALUE(2)=SDGRAN
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=21
        IVALUE(1)='Total Number of Labs:'
        AVALUE(2)=REAL(NLAB)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=17
        IVALUE(1)='Minimum Lab Mean:'
        AVALUE(2)=AMNX
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=17
        IVALUE(1)='Maximum Lab Mean:'
        AVALUE(2)=AMXX
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=15
        IVALUE(1)='Minimum Lab SD:'
        AVALUE(2)=AMNSD
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=15
        IVALUE(1)='Maximum Lab SD:'
        AVALUE(2)=AMXSD
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=23
        IVALUE(1)='Within Lab (pooled) SD:'
        AVALUE(2)=SQRT(S2WPOO)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=29
        IVALUE(1)='Within Lab (pooled) Variance:'
        AVALUE(2)=S2WPOO
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
C  TABLE 1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=34
        IHEAD(1:NHEAD)='Table 1: Summary Statistics by Lab'
CCCCC   IFRMT5=' '
CCCCC   IFRMT5(1:34)='(I8,2X,I8,4(F15.7,2X))'
CCCCC   WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NCOL=6
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
C
        DO6005ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6005   CONTINUE
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC2
        DO6008I=3,NCOL
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6008   CONTINUE
        NUMDI2(1)=0
        NUMDI2(2)=0
C
        IVALUE(1)=' b Lab ID'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
C
        IVALUE(2)=' b n(i)'
        IVALUE(2)(1:1)=IBASLC
        NCHAR(2)=7
C
        IVALUE(3)=' b Mean'
        IVALUE(3)(1:1)=IBASLC
        NCHAR(3)=7
C
        IVALUE(4)=' b Variance'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=11
C
        IVALUE(5)=' b Standard line Deviation'
        IVALUE(5)(1:1)=IBASLC
        IVALUE(5)(12:12)=IBASLC
        NCHAR(5)=26
C
        IVALUE(6)=' b Standard Deviation line of the Mean'
        IVALUE(6)(1:1)=IBASLC
        IVALUE(6)(22:22)=IBASLC
        NCHAR(6)=38
C
        NHEAD=NCOL
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        IFLAG1=.FALSE.
        ICNT=0
        DO6110ISET1=1,NLAB
            ICNT=ICNT+1
            AVALUE(1)=Y3(ISET1)
            AVALUE(2)=REAL(N(ISET1))
            AVALUE(3)=X(ISET1)
            AVALUE(4)=ASD(ISET1)**2
            AVALUE(5)=ASD(ISET1)
            AVALUE(6)=SQRT(T(ISET1))
            IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
            CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6110     CONTINUE
C
          CALL DPRTF6(NHEAD)
          IFLAG1=.TRUE.
          IFLAG2=.FALSE.
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('                  Consensus Means Analysis')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4002)
 4002   FORMAT('                      (Full Sample Case)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)
 4003   FORMAT('Data Summary:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)IHLEFT,IHLEF2
 4011   FORMAT('Response Variable:               ',7X,A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)IHRIGH,IHRIG2
 4012   FORMAT('Lab-ID Variable:                 ',7X,A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)NPTS
 4013   FORMAT('Total Number of Observations:    ',7X,I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4016)XGRAND
 4016   FORMAT('Grand Mean:                      ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4017)SDGRAN
 4017   FORMAT('Grand Standard Deviation:        ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4018)NLAB
 4018   FORMAT('Total Number of Labs:            ',7X,I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)AMNX
 4021   FORMAT('Minimum Lab Mean:                ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4022)AMXX
 4022   FORMAT('Maximum Lab Mean:                ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)AMNSD
 4023   FORMAT('Minimum Lab SD:                  ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4024)AMXSD
 4024   FORMAT('Maximum Lab SD:                  ',F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)SQRT(S2WPOO)
 4031   FORMAT('Within Lab (pooled) SD:          ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)S2WPOO
 4032   FORMAT('Within Lab (pooled) Variance:    ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4100)
 4100   FORMAT('Table 1: Summary Statistics by Lab')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(
     1'                                                         ',
     1'           Standard')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4103)
 4103   FORMAT(
     1'     Lab                                            Standard',
     1'       Deviation')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4104)
 4104 FORMAT(
     1'      ID    n(i)       Mean          Variance      Deviation',
     1'         of Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4106)
 4106   FORMAT(
     1'------------------------------------------------------',
     1'----------------------')
        CALL DPWRST('XXX','WRIT')
C
        IFORMT=' '
        IFORMT='(I8,I8,4(F15.7))'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(14:14),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(I8,I8,4(E15.7))'
        ENDIF
C
        DO4150I=1,NLAB
          WRITE(ICOUT,IFORMT)INT(Y3(I)),N(I),X(I),ASD(I)**2,ASD(I),
     1                     SQRT(T(I))
C4156     FORMAT(I8,I8,4F15.7)
          CALL DPWRST('XXX','WRIT')
 4150   CONTINUE
C
        WRITE(ICOUT,4106)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      DO4190I=1,NLAB
        WRITE(IOUNI1,4196)REAL(I),REAL(N(I)),X(I),ASD(I)**2,
     1                    ASD(I),SQRT(T(I))
 4196   FORMAT(F6.0,2X,F6.0,2X,4E15.7)
 4190 CONTINUE
C
C               *************************************
C               **  STEP 80--                      **
C               **  REMOVE ANY LABS WITH LESS THAN **
C               **  TWO OBSERVATIONS               **
C               *************************************
C
      ICNT=0
      DO9100I=1,NLAB
        IF(ASD(I).GT.0.0)THEN
          ICNT=ICNT+1
          AMEAN(ICNT)=AMEAN(I)
          ASD(ICNT)=ASD(I)
          N(ICNT)=N(I)
        ELSE
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
            WRITE(ICOUT,9201)
 9201       FORMAT('
')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
            WRITE(ICOUT,9301)IBASLC
 9301       FORMAT(A1,'begin{verbatim}')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
            IRTFMD='VERB'
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          WRITE(ICOUT,9103)I
 9103     FORMAT('LAB ',I8,' HAS A NON-POSITIVE STANDARD DEVIATION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,9105)
 9105     FORMAT('THIS LAB WILL BE OMITTED FROM THE ANALYSIS.')
          CALL DPWRST('XXX','WRIT')
C
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
            WRITE(ICOUT,9211)
 9211       FORMAT('
')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
            WRITE(ICOUT,9311)IBASLC
 9311       FORMAT(A1,'end{verbatim}')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
            IRTFMD='OFF'
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
 9100 CONTINUE
      NLAB=ICNT
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN3')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMAN3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NUMVAR
 9013   FORMAT('NPTS,NUMVAR = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IBUGA3
 9014   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
 9025   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMAN4(Y1,Y2,Y3,NLAB,NTOT,
     1DAT,X,T,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,IHRIGH,IHRIG2,IHRI21,IHRI22,
     1ASM,ASD2,SDGRAN,
     1XGRAND,S2WPOO,SW,
     1AMNX,AMXX,
     1IWRITE,IOUNI1,
     1ICAPSW,ICAPTY,NUMDIG,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE INITIAL SUMMARY TABLES FOR CONSENSUS MEANS
C              COMMAND (SUMMARY DATA CASE).
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
C
      CHARACTER*1 IBASLC
      CHARACTER*40 IFORMT
C
      REAL ATEMP
      REAL RIGHT
      REAL XGRAND
      REAL SW
      REAL S2WPOO
      REAL SDGRAN
      REAL AMNX
      REAL AMXX
      REAL ASM
      REAL ASD2
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
      REAL AMEAN(*)
      REAL ASD(*)
C
      INTEGER N(*)
C
      REAL DAT(*)
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION T(*)
C
      COMMON /MPCOM/ T0, T1
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      INCLUDE 'DPCOST.INC'
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMA'
      ISUBN2='N3  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN4')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAN4--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NUMVAR,IOUNI1
   52   FORMAT('NPTS,NUMVAR,IOUNI1 = ',3I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
C               ***********************************************
C               **  STEP 2.2--                               **
C               **  COMPUTE THE SUMMARY STATISTICS BY LAB    **
C               **  1) DETERMINE NUMER OF POINTS IN EACH LAB **
C               **  2) MEAN FOR EACH LAB                     **
C               **  3) SD FOR EACH LAB                       **
C               ***********************************************
C
      T0=10000000.D0
      T1=-T0
C
      AMNX=CPUMAX
      AMXX=CPUMIN
      AMNSD=CPUMAX
      AMXSD=CPUMIN
C
      DO250I=1,NLAB
C
        X(I)=DBLE(Y1(I))
        IF(X(I).LT.T0) T0=X(I)
        IF(X(I).GT.T1) T1=X(I)
        AMEAN(I)=Y1(I)
        ASD(I)=Y2(I)
        N(I)=INT(Y3(I)+0.5)
C
        IF(N(I).EQ.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,211)
  211     FORMAT('***** ERROR IN CONSENSUS MEANS ANALYSIS--')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,254)I
  254     FORMAT('      LAB ',I8,' HAS NO DATA')
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        T(I)=DBLE(ASD(I))**2/DBLE(N(I))
        IF(AMEAN(I).LT.AMNX)AMNX=AMEAN(I)
        IF(AMEAN(I).GT.AMXX)AMXX=AMEAN(I)
C
        IF(ASD(I).LE.0.0)THEN
CCCCC     WRITE(ICOUT,999)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,211)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,264)I
CC264     FORMAT('      LAB ',I8,' HAS A NON-POSITIVE ',
CCCCC1           'STANDARD DEVIATION.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,266)
CC266     FORMAT('      THIS HAPPENS IF THE LAB HAS A SINGLE ',
CCCCC1           'DATA POINT')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,267)
CC267     FORMAT('      OR IF ALL THE DATA POINTS HAVE THE SAME ',
CCCCC1           'VALUE.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,269)
CC269     FORMAT('      RE-RUN THE CONSENSUS MEANS ANALYSIS WITH ',
CCCCC1           'THIS LAB OMITTED.')
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     IERROR='YES'
CCCCC     GOTO9000
CCCCC   ENDIF
C
        ELSE
          IF(ASD(I).LT.AMNSD)AMNSD=ASD(I)
          IF(ASD(I).GT.AMXSD)AMXSD=ASD(I)
        ENDIF
C
  250 CONTINUE
C
      DSUM1=0.0D0
      DO310I=1,NLAB
        DSUM1=DSUM1 + (DBLE(N(I))/DBLE(NTOT))*DBLE(AMEAN(I))
  310 CONTINUE
      XGRAND=DSUM1
C
      DSUM1=0.0D0
      DO315I=1,NLAB
        DSUM1=DSUM1 + DBLE(N(I))*DBLE(ASD(I))
  315 CONTINUE
      SDGRAN=REAL(DSUM1/DBLE(NTOT-NLAB))
C
      CALL MEAN(AMEAN,NLAB,IWRITE,ASM,IBUGA3,IERROR)
      CALL SD(AMEAN,NLAB,IWRITE,ASD2,IBUGA3,IERROR)
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DO320J=1,NLAB
        DTERM1=DBLE(N(J)-1.0D0)
        DSUM2=DSUM2 + DTERM1*(DBLE(ASD(J))**2)
        DSUM3=DSUM3 + DTERM1
        DSUM1=DSUM1 + DBLE(ASD(J))**2/DBLE(N(J))
  320 CONTINUE
      XJUNK=XGRAND
      DTEMP=DSQRT(DSUM1)/DBLE(NLAB)
      S2WPOO=DSUM2/DSUM3
      SW=REAL(DTEMP)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5102)
C5102   FORMAT('
Consensus Mean Analysis

')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5103)
C5103   FORMAT('
(Summary Statistics Case)
')
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('   ')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5114)
 5114   FORMAT('      Consensus Mean Analysis
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('      (Summary Statistics Case)    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('   
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5193   FORMAT('
')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
 5135   FORMAT('         Summary Statistics:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
 5136   FORMAT('         Mean Variable:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)IHLEFT,IHLEF2
 5137   FORMAT('         ',A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5140)
 5140   FORMAT('         SD Variable:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)IHRIGH,IHRIG2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55140)
55140   FORMAT('         Sample Size Variable:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)IHRI21,IHRI22
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         Total Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)NTOT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         Grand Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XGRAND
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5143)
 5143   FORMAT('         Pooled Standard Deviation:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SDGRAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         Total Number of Labs:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)NLAB
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5164)
 5164   FORMAT('         Minimum Lab Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMNX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5165)
 5165   FORMAT('         Maximum Lab Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMXX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
 5166   FORMAT('         Minimum Lab SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMNSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5167)
 5167   FORMAT('         Maximum Lab SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AMXSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         Within Lab (pooled) SD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SQRT(S2WPOO)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         Within Lab (pooled) Variance:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2WPOO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
 5215   FORMAT('      Table 1: Summary Statistics By Lab')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
 5222   FORMAT('      		')
 5223   FORMAT('      ')
 5227   FORMAT('      ')
 5226   FORMAT('      ')
        IFORMT='(9X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(9:9),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(9X,E15.7)'
        ENDIF
        DO5240I=1,NLAB
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5225)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)I
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5225)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)N(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5226)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)X(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5226)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASD(I)**2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5226)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASD(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5226)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SQRT(T(I))
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
 5240   CONTINUE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8001   FORMAT(A1,'end{verbatim}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT('{',A1,'bf Consensus Mean Analysis}')
 8004   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
 8007   FORMAT('{',A1,'bf (Summary Statistic Case)}')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf Data Summary:} & ',2X,A1,A1)
 8012   FORMAT(5X,'Mean Variable: & ',A4,A4,2X,A1,A1)
 8013   FORMAT(5X,'SD Variable: & ',A4,A4,2X,A1,A1)
 8113   FORMAT(5X,'Sample Size Variable: & ',A4,A4,2X,A1,A1)
 8014   FORMAT(5X,'Total Number of Observations: & ',I8,2X,A1,A1)
 8015   FORMAT(5X,'Grand Mean: & ',F15.7,2X,A1,A1)
 8016   FORMAT(5X,'Pooled Standard Deviation: & ',F15.7,2X,A1,A1)
 8017   FORMAT(5X,'Total Number of Labs: & ',I8,2X,A1,A1)
 8018   FORMAT(5X,'Minimum Lab Mean:  &  ',F15.7,2X,A1,A1)
 8019   FORMAT(5X,'Maximum Lab Mean:  &  ',F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Minimum Lab SD:  &  ',F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Maximum Lab SD:  &  ',F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Within Lab (Pooled) SD:  &  ',F15.7,2X,A1,A1)
 8023   FORMAT(5X,'Within Lab (Pooled) Variance:  &  ',
     1         F15.7,2X,A1,A1)

        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)IHLEFT,IHLEF2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IHRIGH,IHRIG2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8113)IHRI21,IHRI22,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)NTOT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8015)XGRAND,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8016)SDGRAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)NLAB,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8018)AMNX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)AMXX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)AMNSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)AMXSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)SQRT(S2WPOO),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)S2WPOO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8040   FORMAT(5X,'{',A1,'bf Table 1: Summary Statistics by Lab}')
 8041   FORMAT(5X,A1,'begin{tabular} {|c|c|c|c|c|c|}')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8043   FORMAT(5X,A1,'hline')
 8044   FORMAT(5X,' & &  &  & Standard  & Standard Deviation ',A1,A1)
 8045   FORMAT(5X,'Lab ID & N(I) & Mean & Variance & ',
     1         'Deviation & of the Mean ',A1,A1)
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        DO8050I=1,NLAB
C
          IF(NUMDIG.EQ.1)THEN
            WRITE(ICOUT,8051)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8051      FORMAT(5X,I5,' & ',I8,' & ',F15.1,' & ',F15.1,' & ',
     1            F15.1,' & ',F15.1,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.2)THEN
            WRITE(ICOUT,8052)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8052      FORMAT(5X,I5,' & ',I8,' & ',F15.2,' & ',F15.2,' & ',
     1            F15.2,' & ',F15.2,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.3)THEN
            WRITE(ICOUT,8053)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8053      FORMAT(5X,I5,' & ',I8,' & ',F15.3,' & ',F15.3,' & ',
     1            F15.3,' & ',F15.3,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.4)THEN
            WRITE(ICOUT,8054)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8054      FORMAT(5X,I5,' & ',I8,' & ',F15.4,' & ',F15.4,' & ',
     1            F15.4,' & ',F15.4,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.5)THEN
            WRITE(ICOUT,8055)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8055      FORMAT(5X,I5,' & ',I8,' & ',F15.5,' & ',F15.5,' & ',
     1            F15.5,' & ',F15.5,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.6)THEN
            WRITE(ICOUT,8056)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8056      FORMAT(5X,I5,' & ',I8,' & ',F15.6,' & ',F15.6,' & ',
     1            F15.6,' & ',F15.6,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.7)THEN
            WRITE(ICOUT,8057)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8057      FORMAT(5X,I5,' & ',I8,' & ',F15.7,' & ',F15.7,' & ',
     1            F15.7,' & ',F15.7,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.8)THEN
            WRITE(ICOUT,8058)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8058      FORMAT(5X,I5,' & ',I8,' & ',F15.8,' & ',F15.8,' & ',
     1            F15.8,' & ',F15.8,2X,A1,A1)
          ELSEIF(NUMDIG.EQ.9)THEN
            WRITE(ICOUT,8059)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8059      FORMAT(5X,I5,' & ',I8,' & ',F15.9,' & ',F15.9,' & ',
     1            F15.9,' & ',F15.9,2X,A1,A1)
          ELSEIF(NUMDIG.GE.10)THEN
            WRITE(ICOUT,8060)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8060      FORMAT(5X,I5,' & ',I8,' & ',E15.7,' & ',E15.7,' & ',
     1            E15.7,' & ',E15.7,2X,A1,A1)
          ELSE
            WRITE(ICOUT,8061)I,N(I),X(I),ASD(I)**2,ASD(I),
     1                       SQRT(T(I)),
     1                       IBASLC,IBASLC,IBASLC
 8061      FORMAT(5X,I5,' & ',I8,' & ',F15.7,' & ',F15.7,' & ',
     1            F15.7,' & ',F15.7,2X,A1,A1)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8050   CONTINUE
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  WRITE HEADER LINE
C
 6193   FORMAT(A1,'fs',I1)
 6195   FORMAT(A1,'fs',I2)
        ITEMP2=INT(REAL(IRTFPS)*1.5)
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSEIF(ITEMP2.LE.99)THEN
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          ITEMP2=99
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IRTFMD='OFF'
        IFLAG1=.TRUE.
        IHEAD(1:37)=' b           Consensus Means Analysis'
        IHEAD(38:74)=' line       (Summary Statistic Case)'
        IHEAD(1:1)=IBASLC
        IHEAD(38:38)=IBASLC
        NHEAD=74
        CALL DPRTF8(IHEAD,NHEAD,ITEMP,IFLAG1)
        NHEAD=0
C
        ITEMP2=IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSEIF(ITEMP2.LE.99)THEN
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          ITEMP2=99
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  SUMMARY INFORMATION
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*3500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b Data Summary:'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=16
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='Response Variable:'
        NCHAR(1)=18
        IVALUE(2)(1:4)=IHLEFT(1:4)
        IVALUE(2)(5:8)=IHLEF2(1:4)
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='Lab-ID Variable:'
        NCHAR(1)=16
        IVALUE(2)(1:4)=IHRIGH(1:4)
        IVALUE(2)(5:8)=IHRIG2(1:4)
        NCHAR(2)=8
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=29
        IVALUE(1)='Total Number of Observations:'
        AVALUE(2)=REAL(NTOT)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=11
        IVALUE(1)='Grand Mean:'
        AVALUE(2)=XGRAND
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=25
        IVALUE(1)='Pooled Standard Deviation:'
        AVALUE(2)=SDGRAN
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=21
        IVALUE(1)='Total Number of Labs:'
        AVALUE(2)=REAL(NLAB)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=17
        IVALUE(1)='Minimum Lab Mean:'
        AVALUE(2)=AMNX
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=17
        IVALUE(1)='Maximum Lab Mean:'
        AVALUE(2)=AMXX
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=15
        IVALUE(1)='Minimum Lab SD:'
        AVALUE(2)=AMNSD
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=15
        IVALUE(1)='Maximum Lab SD:'
        AVALUE(2)=AMXSD
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=23
        IVALUE(1)='Within Lab (pooled) SD:'
        AVALUE(2)=SQRT(S2WPOO)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=29
        IVALUE(1)='Within Lab (pooled) Variance:'
        AVALUE(2)=S2WPOO
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
C  TABLE 1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=34
        IHEAD(1:NHEAD)='Table 1: Summary Statistics by Lab'
CCCCC   IFRMT5=' '
CCCCC   IFRMT5(1:34)='(I8,2X,I8,4(F15.7,2X))'
CCCCC   WRITE(IFRMT5(20:20),'(I1)')NUMDIG
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NCOL=6
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
C
        DO6005ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6005   CONTINUE
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC2
        DO6008I=3,NCOL
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6008   CONTINUE
        NUMDI2(1)=0
        NUMDI2(2)=0
C
        IVALUE(1)=' b Lab ID'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
C
        IVALUE(2)=' b n(i)'
        IVALUE(2)(1:1)=IBASLC
        NCHAR(2)=7
C
        IVALUE(3)=' b Mean'
        IVALUE(3)(1:1)=IBASLC
        NCHAR(3)=7
C
        IVALUE(4)=' b Variance'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=11
C
        IVALUE(5)=' b Standard line Deviation'
        IVALUE(5)(1:1)=IBASLC
        IVALUE(5)(12:12)=IBASLC
        NCHAR(5)=26
C
        IVALUE(6)=' b Standard Deviation line of the Mean'
        IVALUE(6)(1:1)=IBASLC
        IVALUE(6)(22:22)=IBASLC
        NCHAR(6)=38
C
        NHEAD=NCOL
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NCHAR(1)=0
        IVALUE(1)=' '
        IFLAG1=.FALSE.
        ICNT=0
        DO6110ISET1=1,NLAB
            ICNT=ICNT+1
            AVALUE(1)=Y3(ISET1)
            AVALUE(2)=REAL(N(ISET1))
            AVALUE(3)=X(ISET1)
            AVALUE(4)=ASD(ISET1)**2
            AVALUE(5)=ASD(ISET1)
            AVALUE(6)=SQRT(T(ISET1))
            IF(ISET1.EQ.NLAB)IFLAG1=.TRUE.
            CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6110     CONTINUE
C
          CALL DPRTF6(NHEAD)
          IFLAG1=.TRUE.
          IFLAG2=.FALSE.
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('                  Consensus Means Analysis')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4002)
 4002   FORMAT('                  (Summary Statistics Case)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)
 4003   FORMAT('Data Summary:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)IHLEFT,IHLEF2
 4011   FORMAT('Mean Variable:                   ',7X,A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)IHRIGH,IHRIG2
 4012   FORMAT('SD Variable:                     ',7X,A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4019)IHRI21,IHRI22
 4019   FORMAT('Sample Size Variable:            ',7X,A4,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)NTOT
 4013   FORMAT('Total Number of Observations:    ',7X,I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4016)XGRAND
 4016   FORMAT('Grand Mean:                      ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4017)SDGRAN
 4017   FORMAT('Pooled Standard Deviation:       ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4018)NLAB
 4018   FORMAT('Total Number of Labs:            ',7X,I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)AMNX
 4021   FORMAT('Minimum Lab Mean:                ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4022)AMXX
 4022   FORMAT('Maximum Lab Mean:                ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)AMNSD
 4023   FORMAT('Minimum Lab SD:                  ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4024)AMXSD
 4024   FORMAT('Maximum Lab SD:                  ',F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)SQRT(S2WPOO)
 4031   FORMAT('Within Lab (pooled) SD:          ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)S2WPOO
 4032   FORMAT('Within Lab (pooled) Variance:    ',F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4100)
 4100   FORMAT('Table 1: Summary Statistics by Lab')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4101)
 4101   FORMAT(
     1'                                                         ',
     1'          Standard')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4103)
 4103   FORMAT(
     1'     Lab                                            Standard',
     1'      Deviation')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4104)
 4104 FORMAT(
     1'      ID    n(I)       Mean          Variance      Deviation',
     1'        of Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4106)
 4106   FORMAT(
     1'------------------------------------------------------',
     1'---------------------')
        CALL DPWRST('XXX','WRIT')
C
        IFORMT=' '
        IFORMT='(I8,I8,4(F15.7))'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(14:14),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(I8,I8,4(E15.7))'
        ENDIF
C
        DO4150I=1,NLAB
          WRITE(ICOUT,IFORMT)I,N(I),X(I),ASD(I)**2,ASD(I),SQRT(T(I))
C4156     FORMAT(I8,I8,4F15.7)
          CALL DPWRST('XXX','WRIT')
 4150   CONTINUE
C
        WRITE(ICOUT,4106)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      DO4190I=1,NLAB
        WRITE(IOUNI1,4196)REAL(I),REAL(N(I)),X(I),ASD(I)**2,
     1                    ASD(I),SQRT(T(I))
 4196   FORMAT(F6.0,2X,F6.0,2X,4E15.7)
 4190 CONTINUE
C
C               *************************************
C               **  STEP 80--                      **
C               **  REMOVE ANY LABS WITH LESS THAN **
C               **  TWO OBSERVATIONS               **
C               *************************************
C
      ICNT=0
      DO9100I=1,NLAB
        IF(ASD(I).GT.0.0)THEN
          ICNT=ICNT+1
          AMEAN(ICNT)=AMEAN(I)
          ASD(ICNT)=ASD(I)
          N(ICNT)=N(I)
        ELSE
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
            WRITE(ICOUT,9201)
 9201       FORMAT('
')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
            WRITE(ICOUT,9301)IBASLC
 9301       FORMAT(A1,'begin{verbatim}')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
            IRTFMD='VERB'
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          WRITE(ICOUT,9103)I
 9103     FORMAT('LAB ',I8,' HAS A NON-POSITIVE STANDARD DEVIATION.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,9105)
 9105     FORMAT('THIS LAB WILL BE OMITTED FROM THE ANALYSIS.')
          CALL DPWRST('XXX','WRIT')
C
          IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
            WRITE(ICOUT,9211)
 9211       FORMAT('
')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
            WRITE(ICOUT,9311)IBASLC
 9311       FORMAT(A1,'end{verbatim}')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
            IRTFMD='OFF'
          ELSE
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
 9100 CONTINUE
      NLAB=ICNT
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN4')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMAN4--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NTOT
 9013   FORMAT('NTOT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)IBUGA3
 9014   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
 9025   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMAN5(NPTS,NLAB,
     1XGRAND,XMPS,XMMPS,XMLS,XSE,
     1ASM,XGD,XGCI,XDL,XFAIR,XBCP,
     1DLOWMP,DHIGMP,DLOWMM,DHIGMM,DLOWML,DHIGML,
     1DLOWBO,DHIGBO,DLOWSE,DHIGSE,DLOWT1,DHIGT1,
     1DLOWT2,DHIGT2,DLOWGD,DHIGGD,DLOWGC,DHIGGC,
     1DLOWDL,DHIGDL,DLOWD2,DHIGD2,
     1DLOWFW,DHIGFW,DLOWF2,DHIGF2,DLOWF3,DHIGF3,
     1DLOWBC,DHIGBC,
     1IWRITE,IOUNI2,
     1ICAPSW,ICAPTY,NUMDIG,IFLAG9,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE THE CONFIDENCE INTERVAL TABLE FOR THE
C              CONSENSUS MEANS COMMAND
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2
C                                       ROUTINE
C     UPDATED  VERSION--JUNE      2006. ADD FAIRWEATHER, BCP
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
      CHARACTER*1 IQUOTE
      CHARACTER*40 IFORMT
C
      CHARACTER*25 IMETH
C
      REAL XMP
      REAL XMPS
      REAL XMMPS
      REAL XML
      REAL XMLS
      REAL ASM
      REAL XGRAND
      REAL XGD
      REAL XSE
      REAL XGCI
      REAL XDL
      REAL XFAIR
      REAL XBCP
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
      LOGICAL IFLAG9
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMA'
      ISUBN2='N2  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN5')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAN5--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
 5107   FORMAT('
    ')
 5111   FORMAT('')
 5113   FORMAT('   ')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5141   FORMAT('          ',A25)
 5142   FORMAT('         ',A25)
 5143   FORMAT('         ',A25)
 5148   FORMAT('      
    ')
 5115   FORMAT('      Table 2: 95% Confidence Limits')
 5119   FORMAT('   
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5158   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
 5193   FORMAT('
')
C5195   FORMAT('
')
 5223   FORMAT('      
')
 5226   FORMAT('      ')
 5227   FORMAT('      
')
 5113   FORMAT('   ')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)IK+2,IUNCT,IK
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5141   FORMAT('          ',A25)
 5142   FORMAT('         ',A25)
 5148   FORMAT('      
')
 5115   FORMAT('      Table ',I1,': ',A8,' Uncertainties ',
     1         '(k = ',I1,')')
 5119   FORMAT('   
')
 5127   FORMAT('      ')
 5128   FORMAT('   
')
 5158   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5153   FORMAT('         ',F15.5)
 5155   FORMAT('          ')
 5191   FORMAT('
')
 5193   FORMAT('')
C5195   FORMAT('
')
 5323   FORMAT('      ')
 5326   FORMAT('      ')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
 5131   FORMAT('         Method')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
 5132   FORMAT('         Consensus
Mean')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)IUNCT,IK
 5133   FORMAT('         ',A8,'
Uncertainty
',
     1         '(k = ',I1,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
 5134   FORMAT('         Relative Standard
Uncertainty',
     1         ' (%)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        IFORMT='(9X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(9:9),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(9X,E15.7)'
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='1. Mandel-Paule'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEMPK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEMPK1/XMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='2. Modified Mandel-Paule'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEMMP1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEMMP1/XMMPS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='3. Vangel-Rukhin ML'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XMLS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEMLK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEMLK1/XMLS
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='4. BOB'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)AKUK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*AKUK1/ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='5. Schiller-Eberhardt'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SESUK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SESUK1/XSE
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='6. Mean of Means'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SET1K1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SET1K1/ASM
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='7. Graybill-Deal'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEGDK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEGDK1/XGD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='8. Grand Mean'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGRAND
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SET2K1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SET2K1/XGRAND
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='9. Generalized CI'
          WRITE(ICOUT,5141)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XGCI
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEGCI
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEGCI/XGCI
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='10. DerSimonian-Laird'
          WRITE(ICOUT,5142)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)SEDLK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*SEDLK1/XDL
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
CCCCC   IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
CCCCC     WRITE(ICOUT,5121)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5148)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     IMETH='11. Fairweather'
CCCCC     WRITE(ICOUT,5142)IMETH
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5127)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5158)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,IFORMT)XFAIR
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5127)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5158)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,IFORMT)SEFWK1
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5127)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5158)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5153)100.0*SEDFW1/XFAIR
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5127)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC     WRITE(ICOUT,5128)
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC   ENDIF
C
        IF(IBCPCM.EQ.'ON')THEN
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5148)
          CALL DPWRST('XXX','WRIT')
          IMETH='12. BCP'
          WRITE(ICOUT,5142)IMETH
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XBCP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,IFORMT)XBCPK1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5158)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5153)100.0*XBCPK1/XBCP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5195)
CCCCC   CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
        CALL DPCONA(39,IQUOTE)
C
C8001   FORMAT(A1,'end{verbatim}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT('{',A1,'bf Table ',I1,': ',A8,
     1         ' Uncertainties ',
     1         '(k = ',I1,')}')
 8004   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8005   FORMAT(A1,'begin{center}')
CCCCC   WRITE(ICOUT,8001)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC,IK+2,IUNCT,IK
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8142   FORMAT(5X,A1,'begin{tabular} {|l|c|c|c|}')
 8143   FORMAT(5X,A1,'hline')
 8144   FORMAT(5X,' & Consensus & ',A8,' & ',
     1         'Relative ',A8,A1,A1)
 8145   FORMAT(5X,'Method & Mean & Uncertainty & Uncertainty (',
     1         A1,'%)',A1,A1)
        WRITE(ICOUT,8142)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8144)IUNCT,IUNCT,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8145)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C8151   FORMAT(5X,'1. Mandel-Paule ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8152   FORMAT(5X,'2. Modified Mandel-Paule ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8153   FORMAT(5X,'3. Vangel-Rukhin ML ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8154   FORMAT(5X,'4. BOB ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8155   FORMAT(5X,'5. Schiller-Eberhardt ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8156   FORMAT(5X,'6. Mean of Means ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8157   FORMAT(5X,'7. Graybill-Deal ',3(' & ',F15.7),
C    1         2X,A1,A1)
C8158   FORMAT(5X,'8. Grand Mean ',3(' & ',F15.7),
C    1         2X,A1,A1)
C
        IFORMT='(5X,A25,3(  &  ,F15.7),2X,A1,A1)'
        IFORMT(11:11)=IQUOTE
        IFORMT(15:15)=IQUOTE
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(21:21),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(5X,A25,3(  &  ,E15.7),2X,A1,A1)'
          IFORMT(11:11)=IQUOTE
          IFORMT(15:15)=IQUOTE
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          IMETH='1. Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMPS,SEMPK1,100.0*SEMPK1/XMPS,
     1                       IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IMMPCM.EQ.'ON')THEN
          IMETH='2. Modified Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMMPS,SEMMP1,100.0*SEMMP1/XMMPS,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IVRUCM.EQ.'ON')THEN
          IMETH='3. Vangel-Rukhin ML'
          WRITE(ICOUT,IFORMT)IMETH,XMLS,SEMLK1,100.0*SEMLK1/XMLS,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IBOBCM.EQ.'ON')THEN
          IMETH='4. BOB'
          WRITE(ICOUT,IFORMT)IMETH,ASM,AKUK1,100.0*AKUK1/ASM,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(ISCECM.EQ.'ON')THEN
          IMETH='5. Schiller-Eberhardt'
          WRITE(ICOUT,IFORMT)IMETH,XSE,SESUK1,100.0*SESUK1/XSE,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IMOMCM.EQ.'ON')THEN
          IMETH='6. Mean of Means'
          WRITE(ICOUT,IFORMT)IMETH,ASM,SET1K1,100.0*SET1K1/ASM,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGRDCM.EQ.'ON')THEN
          IMETH='7. Graybill Deal'
          WRITE(ICOUT,IFORMT)IMETH,XGD,SEGDK1,100.0*SEGDK1/XGD,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGMECM.EQ.'ON')THEN
          IMETH='8. Grand Mean'
          WRITE(ICOUT,IFORMT)IMETH,XGRAND,SET2K1,100.0*SET2K1/XGRAND,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IGCICM.EQ.'ON')THEN
          IMETH='9. Generalized CI'
          WRITE(ICOUT,IFORMT)IMETH,XGCI,SEGCI,100.0*SEGCI/XGCI,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IDSLCM.EQ.'ON')THEN
          IMETH='10. DerSimonian-Laird'
          WRITE(ICOUT,IFORMT)IMETH,XDL,SEDLK1,100.0*SEDLK1/XDL,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
CCCCC   IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
CCCCC     IMETH='11. Fairweather'
CCCCC     WRITE(ICOUT,IFORMT)IMETH,XFAIR,SEFWK1,100.0*SEFWK1/XFAIR,
CCCCC1                   IBASLC,IBASLC
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC   ENDIF
        IF(IBCPCM.EQ.'ON')THEN
          IMETH='12. BCP'
          WRITE(ICOUT,IFORMT)IMETH,XBCP,XBCPK1,100.0*XBCPK1/XBCP,
     1                   IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,8143)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
 8043   FORMAT(5X,A1,'hline')
C8190   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,8190)IBASLC
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
C  TABLE 3/4
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=39
        IHEAD(1:NHEAD)='Table 3: Standard Uncertainties (k = 1)'
        IF(IK.EQ.2)THEN
          IHEAD(1:NHEAD)='Table 4: Expanded Uncertainties (k = 2)'
        ENDIF
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*3800/IDEFPS
        IINC1=IRTFPS*1700/IDEFPS
CCCCC   IINC2=IRTFPS*2000/IDEFPS
C
        DO6005ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          NUMDI2(ISET1)=NUMDIG
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6005   CONTINUE
        ALIGN(1)='l'
C
        IWIDTH(1)=IFRST
        DO6008I=2,NCOL
          IWIDTH(I)=IWIDTH(I-1) + IINC1
 6008   CONTINUE
C
        IVALUE(1)=' b Method'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
C
        IVALUE(2)=' b Consensus line Mean'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(13:13)=IBASLC
        NCHAR(2)=22
C
        IVALUE(3)=' b Standard line Uncertainty line (k=1)'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        IVALUE(3)(29:29)=IBASLC
        NCHAR(3)=39
        IF(IK.EQ.2)THEN
          IVALUE(3)(4:11)='Expanded'
          IVALUE(3)(38:38)='2'
        ENDIF
C
        IVALUE(4)=' b Relative line Standard line Uncertainty (%)'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(12:12)=IBASLC
        IVALUE(4)(26:26)=IBASLC
        NCHAR(4)=46
        IF(IK.EQ.2)THEN
          IVALUE(3)(18:25)='Expanded'
        ENDIF
C
        NHEAD=NCOL
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=3
C
        IF(IMPACM.EQ.'ON')THEN
          NCHAR(1)=16
          IVALUE(1)=' 1. Mandel-Paule'
          AVALUE(2)=XMPS
          AVALUE(3)=SEMPK1
          AVALUE(4)=100.0*SEMPK1/XMPS
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          NCHAR(1)=25
          IVALUE(1)=' 2. Modified Mandel-Paule'
          AVALUE(2)=XMMPS
          AVALUE(3)=SEMMP1
          AVALUE(4)=100.0*SEMMP1/XMMPS
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          NCHAR(1)=20
          IVALUE(1)=' 3. Vangel-Rukhin ML'
          AVALUE(2)=XMLS
          AVALUE(3)=SEMLK1
          AVALUE(4)=100.0*SEMLK1/XMLS
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          NCHAR(1)=7
          IVALUE(1)=' 4. BOB'
          AVALUE(2)=ASM
          AVALUE(3)=AKUK1
          AVALUE(4)=100.0*AKUK1/ASM
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          NCHAR(1)=22
          IVALUE(1)=' 5. Schiller-Eberhardt'
          AVALUE(2)=XSE
          AVALUE(3)=SESUK1
          AVALUE(4)=100.0*SESUK1/XSE
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          NCHAR(1)=17
          IVALUE(1)=' 6. Mean of Means'
          AVALUE(2)=ASM
          AVALUE(3)=SET1K1
          AVALUE(4)=100.0*SET1K1/ASM
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          NCHAR(1)=17
          IVALUE(1)=' 7. Graybill-Deal'
          AVALUE(2)=XGD
          AVALUE(3)=SEGDK1
          AVALUE(4)=100.0*SEGDK1/XGD
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          NCHAR(1)=14
          IVALUE(1)=' 8. Grand Mean'
          AVALUE(2)=XGRAND
          AVALUE(3)=SET2K1
          AVALUE(4)=100.0*SET2K1/XGRAND
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          NCHAR(1)=18
          IVALUE(1)=' 9. Generalized CI'
          AVALUE(2)=XGCI
          AVALUE(3)=SEGCI
          AVALUE(4)=100.0*SEGCI/XGCI
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          NCHAR(1)=21
          IVALUE(1)='10. DerSimonian-Laird'
          AVALUE(2)=XDL
          AVALUE(3)=SEDLK1
          AVALUE(4)=100.0*SEDLK1/XDL
          IFLAG1=.TRUE.
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
CCCCC   IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
CCCCC     NCHAR(1)=15
CCCCC     IVALUE(1)='11. Fairweather'
CCCCC     AVALUE(2)=XFAIR
CCCCC     AVALUE(3)=SEFWK1
CCCCC     AVALUE(4)=100.0*SEFWK1/XFAIR
CCCCC     IFLAG1=.TRUE.
CCCCC     CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
CCCCC   ENDIF
C
        IF(IBCPCM.EQ.'ON')THEN
          NCHAR(1)=7
          IVALUE(1)='12. BCP'
          AVALUE(2)=XBCP
          AVALUE(3)=XBCPK1
          AVALUE(4)=100.0*XBCPK1/XBCP
          CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        ENDIF
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)IK+2,IUNCT,IK
 4001   FORMAT('Table ',I1,':  ',A8,' Uncertainties (k = ',I1,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4010)IUNCT
 4010 FORMAT(
     1'                                                 ',A8,
     1'        Relative ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4011)IUNCT
 4011   FORMAT(
     1'                               Consensus      Uncertainty',
     1'        ',A8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)IK
 4012 FORMAT(
     1'Method                              Mean          (k = ',I1,')',
     1'  Uncertainty (%)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4015)
 4015   FORMAT(
     1'------------------------------------------------------',
     1'--------------------')
        CALL DPWRST('XXX','WRIT')
C
C4065   FORMAT(A25,F15.7,2X,F15.7,2X,F15.5)
 4097   FORMAT(3(E15.7,2X),A25)
C
        IFORMT=' '
        IFORMT='(I8,I8,4(F15.7))'
        IFORMT='(A25,F15.7,2X,F15.7,2X,F15.7)'
        IF(NUMDIG.GE.1 .AND. NUMDIG.LE.9)THEN
          WRITE(IFORMT(10:10),'(I1)')NUMDIG
          WRITE(IFORMT(19:19),'(I1)')NUMDIG
          WRITE(IFORMT(28:28),'(I1)')NUMDIG
        ELSEIF(NUMDIG.GE.10)THEN
          IFORMT='(A25,E15.7,2X,E15.7,2X,E15.7)'
        ENDIF
C
        IF(IMPACM.EQ.'ON')THEN
          IMETH=' 1. Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMPS,SEMPK1,100.0*SEMPK1/XMPS
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMMPCM.EQ.'ON')THEN
          IMETH=' 2. Modified Mandel-Paule'
          WRITE(ICOUT,IFORMT)IMETH,XMMPS,SEMMP1,100.0*SEMMP1/XMMPS
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IVRUCM.EQ.'ON')THEN
          IMETH=' 3. Vangel-Rukhin ML'
          WRITE(ICOUT,IFORMT)IMETH,XMLS,SEMLK1,100.0*SEMLK1/XMLS
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IBOBCM.EQ.'ON')THEN
          IMETH=' 4. BOB'
          WRITE(ICOUT,IFORMT)IMETH,ASM,AKUK1,100.0*AKUK1/ASM
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(ISCECM.EQ.'ON')THEN
          IMETH=' 5. Schiller-Eberhardt'
          WRITE(ICOUT,IFORMT)IMETH,XSE,SESUK1,100.0*SESUK1/XSE
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IMOMCM.EQ.'ON')THEN
          IMETH=' 6. Mean of Means'
          WRITE(ICOUT,IFORMT)IMETH,ASM,SET1K1,100.0*SET1K1/ASM
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGRDCM.EQ.'ON')THEN
          IMETH=' 7. Graybill-Deal'
          WRITE(ICOUT,IFORMT)IMETH,XGD,SEGDK1,100.0*SEGDK1/XGD
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGMECM.EQ.'ON')THEN
          IMETH=' 8. Grand Mean'
          WRITE(ICOUT,IFORMT)IMETH,XGRAND,SET2K1,100.0*SET2K1/XGRAND
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IGCICM.EQ.'ON')THEN
          IMETH=' 9. Generalized CI'
          WRITE(ICOUT,IFORMT)IMETH,XGCI,SEGCI,100.0*SEGCI/XGCI
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IDSLCM.EQ.'ON')THEN
          IMETH='10. DerSimonian-Laird'
          WRITE(ICOUT,IFORMT)IMETH,XDL,SEDLK1,100.0*SEDLK1/XDL
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
CCCCC   IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
CCCCC     IMETH='11. Fairweather'
CCCCC     WRITE(ICOUT,IFORMT)IMETH,XFAIR,SEFWK1,100.0*SEFWK1/XFAIR
CCCCC     CALL DPWRST('XXX','WRIT')
CCCCC   ENDIF
        IF(IBCPCM.EQ.'ON')THEN
          IMETH='12. BCP'
          WRITE(ICOUT,IFORMT)IMETH,XBCP,XBCPK1,100.0*XBCPK1/XBCP
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C
        WRITE(ICOUT,4015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      IF(IMPACM.EQ.'ON')THEN
        IMETH='1. Mandel-Paule'
        WRITE(IOUNIT,4097)XMPS,SEMPK1,100.0*SEMPK1/XMPS,IMETH
      ENDIF
      IF(IMMPCM.EQ.'ON')THEN
        IMETH='2. Modified Mandel-Paule'
        WRITE(IOUNIT,4097)XMMPS,SEMMP1,100.0*SEMMP1/XMMPS,IMETH
      ENDIF
      IF(IVRUCM.EQ.'ON')THEN
        IMETH='3. Vangel-Rukhin ML'
        WRITE(IOUNIT,4097)XMLS,SEMLK1,100.0*SEMLK1/XMLS,IMETH
      ENDIF
      IF(IBOBCM.EQ.'ON')THEN
        IMETH='4. BOB'
        WRITE(IOUNIT,4097)ASM,AKUK1,100.0*AKUK1/ASM,IMETH
      ENDIF
      IF(ISCECM.EQ.'ON')THEN
        IMETH='5. Schiller-Eberhardt'
        WRITE(IOUNIT,4097)XSE,SESUK1,100.0*SESUK1/XSE,IMETH
      ENDIF
      IF(IMOMCM.EQ.'ON')THEN
        IMETH='6. Mean of Means'
        WRITE(IOUNIT,4097)ASM,SET1K1,100.0*SET1K1/ASM,IMETH
      ENDIF
      IF(IGRDCM.EQ.'ON')THEN
        IMETH='7. Graybill-Deal'
        WRITE(IOUNIT,4097)XGD,SEGDK1,100.0*SEGDK1/XGD,IMETH
      ENDIF
      IF(IGMECM.EQ.'ON')THEN
        IMETH='8. Grand Mean'
        WRITE(IOUNIT,4097)XGRAND,SET2K1,100.0*SET2K1/XGRAND,IMETH
      ENDIF
      IF(IGCICM.EQ.'ON')THEN
        IMETH='9. Generalized CI'
        WRITE(IOUNIT,4097)XGCI,SEGCI,100.0*SEGCI/XGCI,IMETH
      ENDIF
      IF(IDSLCM.EQ.'ON')THEN
        IMETH='10. DerSimonian-Laird'
        WRITE(IOUNIT,4097)XDL,SEDLK1,100.0*SEDLK1/XDL,IMETH
      ENDIF
CCCCC IF(IFAICM.EQ.'ON' .AND. IFLAG9)THEN
CCCCC   IMETH='11. Fairweather'
CCCCC   WRITE(IOUNIT,4097)XFAIR,SEFWK1,100.0*SEFWK1/XFAIR,IMETH
CCCCC ENDIF
      IF(IBCPCM.EQ.'ON')THEN
        IMETH='12. BCP'
        WRITE(IOUNIT,4097)XBCP,XBCPK1,100.0*XBCPK1/XBCP,IMETH
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAN6')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMAN6--')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMANN(XTEMP1,XTEMP2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A 2-SAMPLE MANN-WHITNEY RANK SUM TEST
C     EXAMPLE--RANK SUM TEST Y1 Y2
C              RANK SUM TEST Y1 Y2 D0
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/7
C     ORIGINAL VERSION--JULY      1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
      CHARACTER*4 IUSE3
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
      DIMENSION YRANK(2*MAXOBV)
      DIMENSION YTEMP(2*MAXOBV)
      EQUIVALENCE(GARBAG(IGARB1),YRANK(1))
      EQUIVALENCE(GARBAG(IGARB3),YTEMP(1))
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='NN  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
      IUSE3='-999'
C
      NUMVAR=(-999)
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ***************************************
C               **  TREAT THE RANK SUM TEST CASE     **
C               ***************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'MANN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMANN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPMANN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A RANK SUM TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               ****************************************
C               **  STEP 23--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  THIS IS AN OPTIONAL ARGUMENT, BUT **
C               **  IF PRESENT MUST BE A NUMBER OR A  **
C               **  PARAMETER                         **
C               ****************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      D0=0.0
      IF(NUMARG.LT.3)GOTO2390
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IF(IH31.EQ.'SUBS'.AND.IH32.EQ.'ET  ')GOTO2390
      IF(IH31.EQ.'FOR '.AND.IH32.EQ.'    ')GOTO2390
      IF(IH31.EQ.'EXCE'.AND.IH32.EQ.'PT  ')GOTO2390
      IF(IARGT(3).EQ.'NUMB')GOTO2310
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      D0=VALUE(ILOCV)
      GOTO2390
 2310 CONTINUE
      D0=ARG(3)
      GOTO2390
 2390 CONTINUE
C
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'MANN')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPMANN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH A RANK SUM TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPMANN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH A RANK SUM TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               ****************************************
C               **  STEP 52--                         **
C               **  CARRY OUT  THE RANK SUM TEST      **
C               ****************************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'MANN')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPMANN, AS WE ARE ABOUT TO CALL DPMNN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPMNN2(Y,NS1,X,NS2,YRANK,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP1,YTEMP,MAXNXT,
     1STATVA,STTCD2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'MANN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPMA'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STTCD2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW90'
      VALUE0=CUTL90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW95'
      VALUE0=CUTL95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW99'
      VALUE0=CUTL99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMANN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMNN2(Y1,N1,Y2,N2,YRANK,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP,YTEMP,MAXNXT,
     1STATVA,STTCD2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A 2-SAMPLE RANK SUM TEST
C     EXAMPLE--RANK SUM TEST Y1 Y2
C     SAMPLE 1 IS IN INPUT VECTOR Y1
C              (WITH N1 OBSERVATIONS).
C     SAMPLE 2 IS IN INPUT VECTOR Y2
C              (WITH N2 OBSERVATIONS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/6
C     ORIGINAL VERSION--JUNE      1999.
C     UPDATED         --AUGUST    2002. MODIFIED OUTPUT FOR BETTER
C                                       CLARITY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION YRANK(*)
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
C
      DIMENSION C2VL01(25,14)
      DIMENSION C2VL05(25,14)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA ((C2VL05(I,J),J=1,14),I=1,25) /
     1  0,  0, 10,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  0,  6, 11, 17,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  0,  7, 12, 18, 26,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  0,  7, 13, 20, 27, 36,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  3,  8, 14, 21, 29, 38, 39,  0,  0,  0,  0,  0,  0,  0, 
     1  3,  8, 15, 22, 31, 40, 51, 63,  0,  0,  0,  0,  0,  0, 
     1  3,  9, 15, 23, 32, 42, 53, 65, 78,  0,  0,  0,  0,  0, 
     1  4,  9, 16, 24, 34, 44, 55, 68, 81, 96,  0,  0,  0,  0, 
     1  4, 10, 17, 26, 35, 46, 58, 71, 85, 99,115,  0,  0,  0, 
     1  4, 10, 18, 27, 37, 48, 60, 73, 88,103,119,137,  0,  0, 
     1  4, 11, 19, 28, 38, 50, 63, 76, 91,106,123,141,160,  0, 
     1  4, 11, 20, 29, 40, 52, 65, 79, 94,110,127,145,164,185, 
     1  4, 12, 21, 31, 42, 54, 67, 82, 97,114,131,150,169,  0, 
     1  5, 12, 21, 32, 43, 56, 70, 84,100,117,135,154,  0,  0, 
     1  5, 13, 22, 33, 45, 58, 72, 87,103,121,139,  0,  0,  0, 
     1  5, 13, 23, 34, 46, 60, 74, 90,107,124,  0,  0,  0,  0, 
     1  5, 14, 24, 35, 48, 62, 77, 93,110,  0,  0,  0,  0,  0, 
     1  6, 14, 25, 37, 50, 64, 79, 95,  0,  0,  0,  0,  0,  0, 
     1  6, 15, 26, 38, 51, 66, 82,  0,  0,  0,  0,  0,  0,  0, 
     1  6, 15, 27, 39, 53, 68,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  6, 16, 28, 40, 55,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  6, 16, 28, 42,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  7, 17, 29,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  7, 17,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  7,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0/ 
C
      DATA ((C2VL01(I,J),J=1,14),I=1,25) /
     1  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  0,  0,  0, 15,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  0,  0, 10, 16, 23,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     1  0,  0, 10, 17, 24, 32,  0,  0,  0,  0,  0,  0,  0,  0,
     1  0,  0, 11, 17, 25, 34, 43,  0,  0,  0,  0,  0,  0,  0,
     1  0,  6, 11, 18, 26, 35, 45, 56,  0,  0,  0,  0,  0,  0, 
     1  0,  6, 12, 19, 27, 37, 47, 58, 71,  0,  0,  0,  0,  0, 
     1  0,  6, 12, 20, 28, 38, 49, 61, 74, 87,  0,  0,  0,  0, 
     1  0,  7, 13, 21, 30, 40, 51, 63, 76, 90,106,  0,  0,  0, 
     1  0,  7, 14, 22, 31, 41, 53, 65, 79, 93,109,125,147,  0, 
     1  0,  7, 14, 22, 32, 43, 54, 67, 81, 96,112,129,147,  0, 
     1  0,  8, 15, 23, 33, 44, 56, 70, 84, 99,115,133,151,171, 
     1  0,  8, 15, 24, 34, 46, 58, 72, 86,102,119,137,155,  0, 
     1  0,  8, 16, 25, 36, 47, 60, 74, 89,105,122,140,  0,  0, 
     1  0,  8, 16, 26, 37, 49, 62, 76, 92,108,125,  0,  0,  0, 
     1  3,  9, 17, 27, 38, 50, 64, 78, 94,111,  0,  0,  0,  0, 
     1  3,  9, 18, 28, 39, 52, 66, 81, 97,  0,  0,  0,  0,  0, 
     1  3,  9, 18, 29, 40, 53, 68, 83,  0,  0,  0,  0,  0,  0, 
     1  3, 10, 19, 29, 42, 55, 70,  0,  0,  0,  0,  0,  0,  0, 
     1  3, 10, 19, 30, 43, 57,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  3, 10, 20, 31, 44,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  3, 11, 20, 32,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  3, 11, 21,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  4, 11,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 
     1  4,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0/ 
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMN'
      ISUBN2='N2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MNN2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPMNN2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,53)NUMVAR
   53 FORMAT('NUMVAR = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1,N2
   55 FORMAT('N1,N2 = ',2I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,MAX(N1,N2)
      WRITE(ICOUT,57)I,Y1(I),Y2(I)
   57 FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPMNN2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N1
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPMNN2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y1(1)
      DO1135I=2,N1
      IF(Y1(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPMNN2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N2.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPMNN2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N2
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N2.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPMNN2--VARIABLE 2 ',
     1'HAS ONLY 2 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=Y2(1)
      DO1235I=2,N1
      IF(Y2(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPMNN2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      DO4200I=1,N1
        YTEMP(I)=Y1(I)
 4200 CONTINUE
      NTEMP=N1
      DO4210I=1,N2
        NTEMP=NTEMP+1
        YTEMP(NTEMP)=Y2(I)
 4210 CONTINUE
      CALL RANK(YTEMP,NTEMP,IWRITE,YRANK,IBUGA3,IERROR)
C
      W1=0.0
      W2=0.0
      DO4300I=1,N1
        W1=W1+YRANK(I)
 4300 CONTINUE
      DO4310I=N1+1,NTEMP
        W2=W2+YRANK(I)
 4310 CONTINUE
C
      AN1=REAL(N1)
      AN2=REAL(N2)
      IF(N1.EQ.N2)THEN
        U1=W1
        U2=W2
      ELSEIF(N1.LT.N2)THEN
        WADJ=AN1*(AN1+AN2+1.0) - W1
        U1=W1
        U2=WADJ
      ELSEIF(N1.GT.N2)THEN
        WADJ=AN1*(AN1+AN2+1.0) - W2
        U1=WADJ
        U2=W2
      ENDIF
      W=MIN(U1,U2)
      STATVA=W
      U=W
C
      AMEAN=AN1*(AN1+AN2+1.0)/2.0
      ASD=SQRT(MAX(AN1,AN2)*AMEAN/6.0)
C
      NMAX=MAX(N1,N2)
      NMIN=MIN(N1,N2)
      STTCD1=0.0
      STTCD2=0.0
      STTCD3=0.0
      IF(NTEMP.GT.30)THEN
        CALL NORCDF((ABS(W-AMEAN) - 0.5)/ASD,STTCD2)
CCCCC   CALL NORCDF((U1-AMEAN)/ASD,STTCD1)
CCCCC   CALL NORCDF((U2-AMEAN)/ASD,STTCD3)
      ENDIF
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(NTEMP.GT.30)THEN
        CALL NORPPF(.050,CUTL90)
        CUTL90=AMEAN + ASD*CUTL90
        CALL NORPPF(.950,CUTU90)
        CUTU90=AMEAN + ASD*CUTU90
        CALL NORPPF(.025,CUTL95)
        CUTL95=AMEAN + ASD*CUTL95
        CALL NORPPF(.975,CUTU95)
        CUTU95=AMEAN + ASD*CUTU95
        CALL NORPPF(.005,CUTL99)
        CUTL99=AMEAN + ASD*CUTL99
        CALL NORPPF(.995,CUTU99)
        CUTU99=AMEAN + ASD*CUTU99
      ELSE
        CUTL90=-1.0
        CUTU90=-1.0
        CUTL95=C2VL05(3+NMAX,1+NMIN)
        CUTU95=C2VL05(3+NMAX,1+NMIN)
        CUTL99=C2VL01(3+NMAX,1+NMIN)
        CUTU99=C2VL01(3+NMAX,1+NMIN)
      ENDIF
C
      IF(NMAX.GT.30)THEN
CCCCC   IF(STTCD2.GT.0.025.AND.STTCD2.LT.0.975)ICONC2='ACCEPT'
        IF(STTCD2.LE.0.025.OR.STTCD2.GE.0.975)ICONC2='ACCEPT'
CCCCC   IF(STTCD1.LT.0.950)ICONC1='ACCEPT'
CCCCC   IF(STTCD3.LT.0.950)ICONC3='ACCEPT'
      ELSE
CCCCC   IF(U.GT.C2VL05(NMAX-3,NMIN-1))ICONC2='ACCEPT'
        IF(U.LE.C2VL05(NMAX-3,NMIN-1))ICONC2='ACCEPT'
      ENDIF
     
C
C               ****************************************
C               **   STEP 42--                        **
C               **   WRITE OUT EVERYTHING             **
C               **   FOR A 2-SAMPLE RANK SUM TEST     **
C               ****************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4211)
 4211 FORMAT(
     1'                 MANN WHITNEY RANK SUM TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4212)
 4212 FORMAT(
     1'                    (2-SAMPLE)')
      CALL DPWRST('XXX','WRIT')
      IF(D0.EQ.0.0)THEN
        WRITE(ICOUT,4213)
 4213   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEANS MU1 = MU2')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,4215)D0
 4215   FORMAT('NULL HYPOTHESIS UNDER TEST--',
     1         'POPULATION MEANS MU1 - MU2 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,4220)N1
 4220 FORMAT('SAMPLE SIZE FOR VARIABLE 1              = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4221)N2
 4221 FORMAT('SAMPLE SIZE FOR VARIABLE 2              = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4202)
 4202 FORMAT('BEFORE SAMPLE SIZE ADJUSTMENT')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4222)W1
 4222 FORMAT('   RANK SUM FOR VARIABLE 1              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4223)W2
 4223 FORMAT('   RANK SUM FOR VARIABLE 2              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4204)
 4204 FORMAT('AFTER SAMPLE SIZE ADJUSTMENT')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4222)U1
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4223)U2
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4225)W
 4225 FORMAT('RANK SUM TEST STATITIC (U)              = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GE.30)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4226)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4228)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)(U-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)(U1-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)(U2-AMEAN)/ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)STTCD2
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4233)STTCD1
CCCCC   CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4235)STTCD3
CCCCC   CALL DPWRST('XXX','WRIT')
      ENDIF
 4227 FORMAT('NORMAL APPROXIMATIONS (IF NMAX > 20)')
 4226 FORMAT('MEAN OF RANK SUM STATISTIC           = ',G15.7)
 4228 FORMAT('SD OF RANK SUM STATISTIC             = ',G15.7)
 4229 FORMAT('NORMAL APPROXIMATION = (U  - MEAN)/SD   = ',G15.7)
 4230 FORMAT('NORMAL APPROXIMATION = (U1 - MEAN)/SD   = ',G15.7)
 4231 FORMAT('NORMAL APPROXIMATION = (U2 - MEAN)/SD   = ',G15.7)
 4232 FORMAT('RANK SUM STATISTIC CDF VALUE (U)     = ',G15.7)
 4233 FORMAT('RANK SUM STATISTIC CDF VALUE (U1)    = ',G15.7)
 4235 FORMAT('RANK SUM STATISTIC CDF VALUE (U2)    = ',G15.7)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,4258)
 4258 FORMAT('               ALTERNATIVE-             ALTERNATIVE-')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4259)
 4259 FORMAT('ALTERNATIVE-   HYPOTHESIS               HYPOTHESIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4261)
 4261 FORMAT('HYPOTHESIS     ACCEPTANCE INTERVAL      CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      IF(NTEMP.GE.30)THEN
CCCCC WRITE(ICOUT,4262)ICONC1
C4262 FORMAT('MU1 < MU2      (U1) (0.000,0.950)         ',A6)
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4263)ICONC2
 4263 FORMAT('MU1 <> MU2     (U) (0.,0.025) (0.975,1)   ',A6)
      CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,4264)ICONC3
C4264 FORMAT('MU1 > MU2      (U2) (0.000,0.950)         ',A6)
CCCCC CALL DPWRST('XXX','WRIT')
      ELSE
      WRITE(ICOUT,4273)C2VL05(NMAX-3,NMIN-1),ICONC2
 4273 FORMAT('MU1 <> MU2     U  > ',G15.7,    '     ',A6)
      CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 4290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'MAN2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMNN2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9013)AMU0,D0,NUMVAR,ILOCV
 9013 FORMAT('AMU0,D0,NUMVAR,ILOCV = ',2E15.7,I8,I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N1
 9015 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N1
      WRITE(ICOUT,9017)I,Y1(I)
 9017 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N2
 9025 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N2
      WRITE(ICOUT,9027)I,Y2(I)
 9027 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMMEA(NPTS,NLAB,
     1ASM,ASD2,SET2,SET2K1,SET2K2,
     1DLOWT1,DHIGT1,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT MEAN OF MEANS APPROACH TO CONSENSUS MEANS
C     PRINTING--YES
C     SUBROUTINES NEEDED--TPPF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL ASM
      REAL ASD2
      REAL SET2
      REAL SET2K1
      REAL SET2K2
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMM'
      ISUBN2='EA  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMEA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMMEA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB,ASM,ASD2
   52   FORMAT('NPTS,NLAB,ASM,ASD2 = ',2I8,2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      SET2=ASD2/SQRT(REAL(NLAB))
      SET2K1=SET2
      SET2K2=2.0*SET2
      IDF=NLAB-1
      CALL TPPF(0.975,REAL(IDF),APPF)
      DLOWT1=DBLE(ASM - APPF*SET2)
      DHIGT1=DBLE(ASM + APPF*SET2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5193   FORMAT('
')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         6. Method: Mean of Means')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('              ',
     1         'Mean of Lab Means')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)ASM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('              ',
     1         'Standard Deviation of Lab Means')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)ASD2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('              ',
     1         'Standard Uncertainty (sd/sqrt(n)):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SET2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('              ',
     1         'Standard Deviaton of Consensus Mean (sd/sqrt(n)):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SET2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('              ',
     1         'Standard Uncertainty (k = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SET2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('              ',
     1         'Expanded Uncertainty (k = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SET2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)APPF
 5179   FORMAT('              ',
     1         'Expanded Uncertainty (k = ',F10.7,'):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF*SET2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('              ',
     1         'Degrees of Freedom:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('              ',
     1         't Percent Point Value (alpha = 0.05):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('              ',
     1         'Lower 95% (t-value) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWT1)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('              ',
     1         'Upper 95% (t-value) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGT1)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5185)
 5185   FORMAT('              ',
     1         'Note: Mean of Means Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5186)
 5186   FORMAT('              ',
     1         '         ',
     1         'Any Number of Labs, but no Within Lab SD')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 6. Method: Mean of Means:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Mean of Lab Means: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Standard Deviation of Lab Means: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)ASM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)ASD2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8018   FORMAT(5X,'Standard Uncertainty (sd/sqrt(n)): & ',
     1         F15.7,2X,A1,A1)
 8019   FORMAT(5X,'Standard Deviation of Consensus ',
     1         'Mean (sd/sqrt(n)): & ',
     1         F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8018)SET2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)SET2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)SET2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)2.0*SET2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)APPF,APPF*SET2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8024   FORMAT(5X,'Degrees of Freedom: & ',
     1         I8,2X,A1,A1)
 8025   FORMAT(5X,'t Percent Point Value (alpha =  0.05): & ',
     1         F10.7,2X,A1,A1)
 8026   FORMAT(5X,'Lower 95',A1,'% (t-value) Confidence Interval: ',
     1         ' & ',F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (t-value) Confidence Interval: ',
     1         ' & ',F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Mean of Means Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      Any Number of Labs & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8024)IDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)APPF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWT1),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGT1),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 6. Method: Mean of Means'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=27
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=21
        IVALUE(1)='   Mean of Lab Means:'
        AVALUE(2)=ASM
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=35
        IVALUE(1)='   Standard Deviation of Lab Means:'
        AVALUE(2)=ASD2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=37
        IVALUE(1)='   Standard Uncertainty (sd/sqrt(n)):'
        AVALUE(2)=SET2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=37
        IVALUE(1)='   SD of Consensus Mean (sd/sqrt(n)):'
        AVALUE(2)=SET2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SET2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SET2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=41
        IVALUE(1)(1:29)='   Expanded Uncertainty (k = '
        WRITE(IVALUE(1)(30:39),'(F10.7)')APPF
        IVALUE(1)(40:41)='):'
        AVALUE(2)=APPF*SET2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=22
        IVALUE(1)='   Degrees of Freedom:'
        AVALUE(2)=REAL(IDF)
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=34
        IVALUE(1)='   t Percent Point Value of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DLOWT1)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DHIGT1)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Mean of Means Best Usage:'
        NCHAR(1)=34
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         Any Number of Labs:'
        NCHAR(1)=28
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('6.  Method: Mean of Means')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)ASM
 4002   FORMAT('    Mean of Lab Means:                      ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)ASD2
 4003   FORMAT('    Standard Deviation of Lab Means:        ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)SET2
 4011   FORMAT('    Standard Uncertainty (sd/sqrt(n)):      ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)SET2
 4012   FORMAT('    SD of Consensus Mean (sd/sqrt(n)):      ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)SET2
 4013   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)2.0*SET2
 4014   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4015)APPF,APPF*SET2
 4015   FORMAT('    Expanded Uncertainty (k = ',F10.7,'):  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4020)IDF
 4020   FORMAT('    Degrees of Freedom:                     ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4021)APPF
 4021   FORMAT('    t Percent Point Value (alpha = 0.05):   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWT1)
 4022   FORMAT('    Lower 95% (t-value) Confidence Limit:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGT1)
 4023   FORMAT('    Upper 95% (t-value) Confidence Limit:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Mean of Means Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          Any Number of Labs')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMEA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMMEA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)SET2
 9014   FORMAT('SET2 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWT1,DHIGT1
 9015   FORMAT('DLOWT1,DHIGT1 = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMMPL(Y1,Y2,Y3,NPTS,NLAB,
     1X,T,N,
     1XMMPS,S2BMMP,SEMMP,SEMMP1,SEMMP2,
     1DLOWMM,DHIGMM,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT MODIFIED MANDEL-PAULE APPROACH TO
C              CONSENSUS MEANS
C     WRITTEN BY--CODE FOR MODIFIED MANDEL-PAULE PROVIDED BY
C                 MARK VANGEL.
C     PRINTING--YES
C     SUBROUTINES NEEDED--MPSUB
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL XMP
      REAL XMMPS
      REAL S2BMP
      REAL S2BMMP
      REAL SEMMP
      REAL SEMP
      REAL SEMMP1
      REAL SEMMP2
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
C
      INTEGER N(*)
C
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION T(*)
C
      COMMON /MPCOM/ T0, T1
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMM'
      ISUBN2='PL  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMPL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMMPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IMANPA='MODI'
      CALL MPSUB  (NLAB, N, X, T, DXMP, DS2BMP, IMANPA,IBUGA3)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        DO102J=1,NLAB
        WRITE(ICOUT,101)J,T(J)
  101   FORMAT('AFTER MPSUB: J,T(J)=',I8,G15.7)
        CALL DPWRST('XXX','WRIT')
  102   CONTINUE
      ENDIF
C
      XMP=REAL(DXMP)
      S2BMP=REAL(DS2BMP)
C
      CALL NORPPF(0.975,APPF)
      XMPS=REAL((T1-T0)*XMP + T0)
      S2BMPS=REAL(((T1-T0)**2)*S2BMP)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO340J=1,NLAB
        TI=DBLE(S2BMPS) + ((T1-T0)**2)*T(J)
        XJ=(T1-T0)*X(J) + T0
        DSUM1=DSUM1 +  (XJ-DBLE(XMPS))**2/(TI**2)
        DSUM2=DSUM2 + 1.0D0/TI
  340 CONTINUE
      STDERR=SQRT(DSUM1)/DSUM2
      SEMP=REAL(STDERR)
      SEMMP1=SEMP
      SEMMP2=2.0*SEMP
      DLOWER=XMPS - DBLE(APPF)*STDERR
      DUPPER=XMPS + DBLE(APPF)*STDERR
      DLOWMM=DLOWER
      DHIGMM=DUPPER
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5193   FORMAT('
')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         2. Method: Modified Mandel-Paule:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('              ',
     1         'Estimate of (unscaled) Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(XMPS)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('              ',
     1         'Estimate of (scaled) Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(XMP)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('              ',
     1         'Between Lab Variance (unscaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2BMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('              ',
     1         'Between Lab SD (unscaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SQRT(S2BMP)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5175)
 5175   FORMAT('              ',
     1         'Between Lab Variance (scaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2BMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5176)
 5176   FORMAT('              ',
     1         'Standard Deviation of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('              ',
     1         'Standard Uncertainty (k = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('              ',
     1         'Expanded Uncertainty (k = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)APPF
 5179   FORMAT('              ',
     1         'Expanded Uncertainty (k = ',F10.7,'):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF*SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5180)
 5180   FORMAT('              ',
     1         'Normal ppf of 0.975:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('              ',
     1         'Lower 95% (norma) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWER)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('              ',
     1         'Upper 95% (normal) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DUPPER)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('              ',
     1         'Note: Modified Mandel-Paule Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('              ',
     1         '         ',
     1         '6 or More Labs')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 2. Method: Modified Mandel-Paule:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Estimate of (unscaled) Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Estimate of (scaled) Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)REAL(XMPS),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)REAL(XMP),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8016   FORMAT(5X,'Between Lab Variance (unscaled): & ',
     1         F15.7,2X,A1,A1)
 8017   FORMAT(5X,'Between Lab SD (unscaled): & ',
     1         F15.7,2X,A1,A1)
 8018   FORMAT(5X,'Between Lab Variance (scaled): & ',
     1         F15.7,2X,A1,A1)
 8019   FORMAT(5X,'Standard Deviation of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8016)S2BMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)SQRT(S2BMP),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8018)REAL(S2BMP),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)2.0*SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)APPF,APPF*SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8025   FORMAT(5X,'Normal PPF of 0.975: & ',
     1         F10.7,2X,A1,A1)
 8026   FORMAT(5X,'Lower 95',A1,'% (normal) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (normal) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Modified Mandel-Paule Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      6 or More Labs & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8025)APPF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWER),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DUPPER),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 2. Method: Modified Mandel-Paule'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=35
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=41
        IVALUE(1)='   Estimate of (unscaled) Consensus Mean:'
        AVALUE(2)=XMPS
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Estimate of (scaled) Consensus Mean:'
        AVALUE(2)=XMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=35
        IVALUE(1)='   Between Lab Variance (unscaled):'
        AVALUE(2)=S2BMPS
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=29
        IVALUE(1)='   Between Lab SD (unscaled):'
        AVALUE(2)=SQRT(S2BMPS)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=33
        IVALUE(1)='   Between Lab Variance (scaled):'
        AVALUE(2)=S2BMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=40
        IVALUE(1)='   Standard Deviation of Consensus Mean:'
        AVALUE(2)=SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=41
        IVALUE(1)(1:29)='   Expanded Uncertainty (k = '
        WRITE(IVALUE(1)(30:39),'(F10.7)')APPF
        IVALUE(1)(40:41)='):'
        AVALUE(2)=APPF*SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=23
        IVALUE(1)='   Normal PPF of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DLOWER)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DUPPER)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Modified Mandel-Paule Best Usage:'
        NCHAR(1)=42
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         6 or More Labs:'
        NCHAR(1)=24
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('2.  Method: Modified Mandel-Paule')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XMPS
 4002   FORMAT('    Estimate of (unscaled) Consensus Mean:  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)REAL(XMP)
 4003   FORMAT('    Estimate of (scaled) Consensus Mean:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4006)S2BMPS
 4006   FORMAT('    Between Lab Variance (unscaled):        ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4007)SQRT(S2BMPS)
 4007   FORMAT('    Between Lab SD (unscaled):              ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4008)REAL(S2BMP)
 4008   FORMAT('    Between Lab Variance (scaled):          ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)SEMP
 4011   FORMAT('    Standard Deviation of Consensus Mean:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)SEMP
 4012   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)2.0*SEMP
 4013   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)APPF,APPF*SEMP
 4014   FORMAT('    Expanded Uncertainty (k = ',F10.7,'):  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)APPF
 4021   FORMAT('    Normal PPF of 0.975:                    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWER)
 4022   FORMAT('    Lower 95% (normal) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DUPPER)
 4023   FORMAT('    Upper 95% (normal) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Modified Mandel-Paule Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          6 or More Labs')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      XMMPS=REAL(XMPS)
      S2BMMP=REAL(S2BMPS)
      SEMMP=REAL(STDERR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MMPL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMMPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)XMMPS,S2BMMP,SEMMP
 9014   FORMAT('XMMPS,S2BMMP,SEMMP = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWER,DUPPER
 9015   FORMAT('DLOWER,DUPPER = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMNPL(Y1,Y2,Y3,NPTS,NLAB,
     1X,T,N,
     1XMPS,S2BMPS,SEMP,SEMPK1,SEMPK2,
     1DLOWMP,DHIGMP,STXMU,ST2SB,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT MANDEL-PAULE APPROACH TO CONSENSUS MEANS
C     WRITTEN BY--CODE FOR MANDEL-PAULE PROVIDED BY MARK VANGEL.
C     PRINTING--YES
C     SUBROUTINES NEEDED--MPSUB
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPTEMP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL XMP
      REAL XMPS
      REAL S2BMP
      REAL S2BMPS
      REAL SEMP
      REAL SEMPK1
      REAL SEMPK2
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
C
      INTEGER N(*)
C
      DOUBLE PRECISION X(*)
      DOUBLE PRECISION T(*)
C
      COMMON /MPCOM/ T0, T1
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPMN'
      ISUBN2='PL  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNPL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMNPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      IMANPA='REGU'
      CALL MPSUB  (NLAB, N, X, T, DXMP, DS2BMP, IMANPA,IBUGA3)
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        DO102J=1,NLAB
        WRITE(ICOUT,101)J,T(J)
  101   FORMAT('AFTER MPSUB: J,T(J)=',I8,G15.7)
        CALL DPWRST('XXX','WRIT')
  102   CONTINUE
      ENDIF
C
      XMP=REAL(DXMP)
      S2BMP=REAL(DS2BMP)
C
      CALL NORPPF(0.975,APPF)
      XMPS=REAL((T1-T0)*XMP + T0)
      S2BMPS=REAL(((T1-T0)**2)*S2BMP)
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO109J=1,NLAB
        TI=DBLE(S2BMPS) + ((T1-T0)**2)*T(J)
        XJ=(T1-T0)*X(J) + T0
        DSUM1=DSUM1 +  (XJ-DBLE(XMPS))**2/(TI**2)
        DSUM2=DSUM2 + 1.0D0/TI
  109 CONTINUE
C
      STDERR=SQRT(DSUM1)/DSUM2
      SEMP=REAL(STDERR)
      SEMPK1=SEMP
      SEMPK2=2.0*SEMP
      DLOWER=XMPS - DBLE(APPF)*STDERR
      DUPPER=XMPS + DBLE(APPF)*STDERR
      DLOWMP=DLOWER
      DHIGMP=DUPPER
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5126   FORMAT('      ')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('          ')
 5191   FORMAT('
    ')
 5127   FORMAT('      ')
 5128   FORMAT('   
    ')
 5193   FORMAT('
')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         1. Method: Mandel-Paule:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('              ',
     1         'Estimate of (unscaled) Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XMPS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('              ',
     1         'Estimate of (scaled) Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(XMP)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('              ',
     1         'Between Lab Variance (unscaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2BMPS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('              ',
     1         'Between Lab SD (unscaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SQRT(S2BMPS)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5175)
 5175   FORMAT('              ',
     1         'Between Lab Variance (scaled):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)S2BMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5176)
 5176   FORMAT('              ',
     1         'Standard Deviation of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('              ',
     1         'Standard Uncertainty (k = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('              ',
     1         'Expanded Uncertainty (k = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)2.0*SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)APPF
 5179   FORMAT('              ',
     1         'Expanded Uncertainty (k = ',F10.7,'):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF*SEMP
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5180)
 5180   FORMAT('              ',
     1         'Normal ppf of 0.975:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('              ',
     1         'Lower 95% (normal) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWER)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('              ',
     1         'Upper 95% (normal) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DUPPER)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('              ',
     1         'Note: Mandel-Paule Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('              ',
     1         '         ',
     1         '6 or More Labs')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 1. Method: Mandel-Paule:} & ',2X,A1,A1)
 8012   FORMAT(5X,'Estimate of (unscaled) Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Estimate of (scaled) Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XMPS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)REAL(XMP),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8016   FORMAT(5X,'Between Lab Variance (unscaled): & ',
     1         F15.7,2X,A1,A1)
 8017   FORMAT(5X,'Between Lab SD (unscaled): & ',
     1         F15.7,2X,A1,A1)
 8018   FORMAT(5X,'Between Lab Variance (scaled): & ',
     1         F15.7,2X,A1,A1)
 8019   FORMAT(5X,'Standard Deviation of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8016)S2BMPS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)SQRT(S2BMPS),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8018)REAL(S2BMP),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)2.0*SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)APPF,APPF*SEMP,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8025   FORMAT(5X,'Normal PPF of 0.975: & ',
     1         F10.7,2X,A1,A1)
 8026   FORMAT(5X,'Lower 95',A1,'% (normal) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (normal) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Mandel-Paule Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      6 or More Labs & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8025)APPF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWER),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DUPPER),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 1. Method: Mandel-Paule'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=41
        IVALUE(1)='   Estimate of (unscaled) Consensus Mean:'
        AVALUE(2)=XMPS
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Estimate of (scaled) Consensus Mean:'
        AVALUE(2)=XMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=35
        IVALUE(1)='   Between Lab Variance (unscaled):'
        AVALUE(2)=S2BMPS
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=29
        IVALUE(1)='   Between Lab SD (unscaled):'
        AVALUE(2)=SQRT(S2BMPS)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=33
        IVALUE(1)='   Between Lab Variance (scaled):'
        AVALUE(2)=S2BMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=40
        IVALUE(1)='   Standard Deviation of Consensus Mean:'
        AVALUE(2)=SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=2.0*SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=41
        IVALUE(1)(1:29)='   Expanded Uncertainty (k = '
        WRITE(IVALUE(1)(30:39),'(F10.7)')APPF
        IVALUE(1)(40:41)='):'
        AVALUE(2)=APPF*SEMP
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=23
        IVALUE(1)='   Normal PPF of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DLOWER)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DUPPER)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Mandel-Paule Best Usage:'
        NCHAR(1)=33
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         6 or More Labs:'
        NCHAR(1)=24
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('1.  Method: Mandel-Paule')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XMPS
 4002   FORMAT('    Estimate of (unscaled) Consensus Mean:  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)REAL(XMP)
 4003   FORMAT('    Estimate of (scaled) Consensus Mean:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4006)S2BMPS
 4006   FORMAT('    Between Lab Variance (unscaled):        ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4007)SQRT(S2BMPS)
 4007   FORMAT('    Between Lab SD (unscaled):              ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4008)REAL(S2BMP)
 4008   FORMAT('    Between Lab Variance (scaled):          ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4011)SEMP
 4011   FORMAT('    Standard Deviation of Consensus Mean:   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4012)SEMP
 4012   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)2.0*SEMP
 4013   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)APPF,APPF*SEMP
 4014   FORMAT('    Expanded Uncertainty (k = ',F10.7,'):  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)APPF
 4021   FORMAT('    Normal PPF of 0.975:                    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWER)
 4022   FORMAT('    Lower 95% (normal) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DUPPER)
 4023   FORMAT('    Upper 95% (normal) Confidence Limit:    ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Mandel-Paule Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          6 or More Labs')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      STXMU = DXMP
      ST2SB = DS2BMP
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MNPL')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMNPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)XMPS,S2BMPS,SEMP
 9014   FORMAT('XMPS,S2BMPs,SEMP = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWER,DUPPER
 9015   FORMAT('DLOWER,DUPPER = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMARG(IHARG,IARGT,ARG,NUMARG,
     1PDEFMR,
     1PTEXMR,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARGIN FOR TEXT CHARACTERS.
C              THE MARGIN FOR TEXT CHARACTERS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTEXMR.
C     NOTE--THE MARGIN IS IN STANDARDIZED UNITS (0.0 TO 100.0).
C     NOTE--THE MARGIN DOES NOT INCLUDE BETWEEN-LINE GAP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PDEFMR
C                     --IBUGD2
C     OUTPUT ARGUMENTS--PTEXMR
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMARG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PDEFMR
   53 FORMAT('PDEFMR = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************
C               **  TREAT THE MARGIN CASE  **
C               *****************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
C
      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')
     1GOTO1160
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPMARG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR MARGIN ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED (AFTER THE TEXT COMMAND)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THAT THE CURSOR RETURN TO X = 5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      (WHERE THE HORIZONTAL SCREEN UNITS RANGE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      FROM 0 TO 100,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('           MARGIN 5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTEXMR=PDEFMR
      GOTO1180
C
 1160 CONTINUE
      PTEXMR=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE MARGIN (AFTER TEXT IS WRITTEN OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PTEXMR
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)PTEXMR
 8111 FORMAT('THE CURRENT (TEXT) MARGIN IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)PDEFMR
 8112 FORMAT('THE DEFAULT (TEXT) MARGIN IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMARG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PTEXMR
 9013 FORMAT('PTEXMR = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMATC(ICASL7,ICASS7,ILOCV,IFTEXP,IFTORD,
CCCCC SUBROUTINE DPMATC(ICASL7,ILOCV,IFTEXP,
     1IMSUBC,
     1ISEED,
     1IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC OCTOBER 1998.  SPLIT INTO 2 FILES (LAHEY COMPILER
CCCCC SEEMS TO HAVE MEMORY TROUBLES WITH THE FULL ROUTINE).
CCCCC ESSENTIALLY, SPLIT OUT THE MATRIX AND NON-MATRIX COMMANDS.
C
C     PURPOSE--TREAT THE TYPE 7 LET CASE--
C            --NOTE: MATRIX COMMANDS NOW IMPLEMENTED IN DPMAT2
C              (THESE COMMANDS WILL SIMPLY DO A RETURN FROM THIS
C              ROUTINE)
C                      LET Y = SORT X
C                      LET Y = SORTC X X2
C                      LET Y = COCODE X XREF
C                      LET Y = COCOPY X XREF YREF
C                      LET Y = RANK X
C                      LET Y = CODE  X
C                      LET Y = CODEH  X
C                      LET Y = CODE2  X
C                      LET Y = CODE4  X
C                      LET Y = CODE4  X
C                      LET Y = CODE8  X
C                      LET Y = CODE10  X
C                      LET Y = BIWEIGHT X
C                      LET Y = TRICUBE X
C                      LET Y = BOOTSTRAP SAMPLE X1 X2
C                      LET Y = SUBSAMPLE X1 X2
C                      LET Y = JACKNIFE INDEX I N
C
C                      LET Y = FREQUENCY X XD
C                      LET Y = DISTINCT X
C                      LET Y = DIFFERENCE X
C                      LET Y = SEQUENTIAL DIFFERENCE X
C                      LET Y = INTERARRIVAL TIMES X
C                      LET Y = CUMULATIVE DIFFERENCE X
C                      LET Y = CUMULATIVE SUM X
C                      LET Y = CUMULATIVE INTEGRAL X
C                      LET Y = CUMULATIVE PRODUCT X
C                      LET Z = CONVOLUTION X Y
C                      LET Z = DECONVOLUTION X Y
C                      LET Y = SUMD X XD  (NOT IMPLEMENTED)
C                      LET Y2 = INTERPOLATION Y X X2
C                      LET Y2 = LINEAR INTERPOLATION Y X X2
C                      LET Z2 = 2D INTERPOLATION Z Y X Y2 X2
C                      LET Z2 = BILINEAR INTERPOLATION Z Y X Y2 X2
C                      LET Z2 = BIVARIATE INTERPOLATION Z Y X Y2 X2
C
C                      LET T = SINE TRANSFORM Y
C                      LET T = COSINE TRANSFORM Y
C                      LET T1 T2 = FOURIER TRANSFORM Y1 Y2 (OR JUST Y1)
C                      LET T1 T2 = INVERSE FOURIER TRANSFORM Y1 Y2 (OR JUST Y1)
C                      LET T1 T2 = FFT Y1 Y2
C                      LET T1 T2 = INVERSE FFT Y1 Y2
C                      LET T = LAPLACE TRANSFORM Y  (NOT IMPLEMENTED)
C                      LET T = INVERSE LAPLACE TRANSFORM Y (NOT IMPLENETED)
C
C                      LET Y5 Y6 = COMPLEX ADDITION Y1 Y2 Y3 Y4
C                      LET Y5 Y6 = COMPLEX SUBTRACTION Y1 Y2 Y3 Y4
C                      LET Y5 Y6 = COMPLEX MULTIPLICATION Y1 Y2 Y3 Y4
C                      LET Y5 Y6 = COMPLEX DIVISION Y1 Y2 Y3 Y4
C                      LET Y5 Y6 = COMPLEX EXPONENTIATION Y1 Y2
C                      LET Y5 Y6 = COMPLEX SQUARE ROOT Y1 Y2
C                      LET Y5 Y6 = COMPLEX ROOTS Y1 Y2 (OR JUST Y1)
C                      LET Y5 Y6 = COMPLEX CONJUGATE Y1 Y2
C
C                      LET C3 = POLYNOMIAL ADDITION C1 C2
C                      LET C3 = POLYNOMIAL SUBTRACTION C1 C2
C                      LET C3 = POLYNOMIAL MULTIPLICATION C1 C2
C                      LET C3 = POLYNOMIAL DIVISION C1 C2
C                      LET C3 = POLYNOMIAL SQUARE C1
C                      LET C3 = POLYNOMIAL SQUARE ROOT C1  (FUTURE--NOT YET IMP)
C                      LET C3 = POLYNOMIAL GCD C1 C2       (FUTURE--NOT YET IMP)
C                      LET C3 = POLYNOMIAL LCM C1 C2       (FUTURE--NOT YET IMP)
C                      LET Y  = POLYNOMIAL EVALUATION C X
C
C                      LET V3 = VECTOR ADDITION V1 V2
C                      LET V3 = VECTOR SUBTRACTION V1 V2
C                      LET V3 = VECTOR DOT PRODUCT V1 V2 (INNER PRODUCT)
C                      LET V3 = VECTOR CROSS PRODUCT V1 V2 (FUTURE--NOT YET IMP)
C                      LET V3 = VECTOR LENGTH V1
C                      LET V3 = VECTOR DISTANCE V1 V2
C                      LET V3 = VECTOR ANGLE V1 V2
C
C                      LET S3 = SET UNION S1 S2
C                      LET S3 = SET INTERSECTION S1 S2
C                      LET S3 = SET COMPLEMENT S1 S2
C                      LET S3 = SET CARDINALITY S1
C                      LET S3 S4 = SET CARTESIAN PRODUCT S1 S2
C                      LET S3 = SET ELEMENTS S1    (DISTINCT)
C
C                      LET L3 = LOGICAL AND L1 L2 (CONJUNCTION)
C                      LET L3 = LOGICAL OR L1 L2 (DISJUNCTION)
C                      LET L3 = LOGICAL NAND L1 L2
C                      LET L3 = LOGICAL NOR L1 L2
C                      LET L3 = LOGICAL IFTHEN L1 L2 (IMPLICATION)
C                      LET L3 = LOGICAL IFF L1 L2 (EQUIVALENCE)
C                      LET L3 = LOGICAL NOT L1  (NEGATION OR COMPLEMENT)
C                      LET L3 = LOGICAL XOR L1 L2 (EXCLUS. OR OR EXCL. DISJ.)
C
C                      (FOR A FULL OR PARTIAL DATA SET)
C
C                      LET X2 Y2 = FRACTAL X1 Y1
C
C                      LET C3 = GENERATOR MULTIPLICATION C1 C2
C
C                      LET Y2 X2 = BINNED Y  (OR FREQUENCY TABLE)
C                      LET Y2 X2 = ASH BINNED Y
C                      LET Y2 X2 = COUNTS ASH BINNED Y
C                      LET Y2 = CUSUM ARL Y
C                      LET Y2 = ONE-SIDED CUSUM ARL Y
C
C                      LET Y2 = STANDARDIZE Y  (OR ZSCORE, ZSCORE STAN)
C                      LET Y2 = STANDARDIZE Y GROUP1
C                      LET Y2 = STANDARDIZE Y GROUP1 GROUP2
C                      LET Y2 = LOCATION STANDARDIZE Y
C                      LET Y2 = LOCATION STANDARDIZE Y GROUP1
C                      LET Y2 = LOCATION STANDARDIZE Y GROUP1 GROUP2
C                      LET Y2 = SCALE STANDARDIZE Y
C                      LET Y2 = SCALE STANDARDIZE Y GROUP1
C                      LET Y2 = SCALE STANDARDIZE Y GROUP1 GROUP2
C                      LET Y2 = ZSCORE Y
C                      LET Y2 = ZSCORE Y GROUP1
C                      LET Y2 = ZSCORE Y GROUP1 GROUP2
C                      LET Y2 = USCORE Y
C                      LET Y2 = USCORE Y GROUP1
C                      LET Y2 = USCORE Y GROUP1 GROUP2
C                      LET Y2 = CROSS TABULATE Y
C                      LET Y2 = CROSS TABULATE Y GROUP1
C                      LET Y2 = CROSS TABULATE Y GROUP1 GROUP2
C                      LET INDX = MATCH Y X
C                      LET Y2 = MATCH X X2 Y
C                      LET Y2 = REPLACE X X2
C                      LET Y2 = REPLACE X X2 Y
C                      LET Y2 = WINSORIZED Y
C                      LET Y2 = SORT BY  Y GROUP1
C
C                      LET Y X = STACK X1 ... XK
C                      LET Y X1 X2 = REPLICATED STACK X1 ... XK LAB
C                      LET Y = FREQUENCY TO RAW X FREQ
C                      LET Y2 X1 X2 = COMBINE FREQUENCY TABLE Y X
C                      LET Y2 X1 X2 = INTEGER FREQUENCY TABLE Y
C
C                      LET Y = H CONSISTENCY STATISTIC Y X
C                      LET Y = K CONSISTENCY STATISTIC Y X
C
C                      LET Y = L MOMENTS X NMOM
C                      LET Y = PROBABILITY WEIGHTED MOMENTS X NMOM
C                      LET Y = BETA PROBABILITY WEIGHTED MOMENTS X NMOM
C
C     NOTE--THIS SUBROUTINE OPERATES ON A VECTOR
C           AND PRODUCES A VECTOR;
C           THIS IS TO BE CONTRASTED WITH DPLET8 WHICH
C           OPERATES ON A VECTOR
C           BUT PRODUCES A PARAMETER (= A SCALAR).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--MARCH 1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1987.
C     UPDATED         --APRIL     1987.
C     UPDATED         --AUGUST    1987.       COMPLEX SQUARE ROOT
C     UPDATED         --AUGUST    1987.       COMPLEX ROOTS (POLYNOMIAL)
C     UPDATED         --AUGUST    1987.       POLYNOMIAL ARITHMETIC
C     UPDATED         --AUGUST    1987.       VECTOR ARITHMETIC
C     UPDATED         --AUGUST    1987.       SET ARITHMETIC
C     UPDATED         --AUGUST    1987.       LOGICAL ARITHMETIC
C     UPDATED         --SEPTEMBER 1987.       FFT AND INVERSE FFT
C     UPDATED         --SEPTEMBER 1987.       MATRIX OPERATIONS
C     UPDATED         --SEPTEMBER 1987.       COMPLEX CONJUGATE
C     UPDATED         --NOVEMBER  1987.  (EXIT OUT IF ERROR)
C     UPDATED         --FEBRUARY  1988.  (BIWEIGHT AND TRICUBE)
C     UPDATED         --JULY      1988.  FRACTAL
C     UPDATED         --AUGUST    1988.  LENGTH TRAP FOR FRACTAL
C     UPDATED         --JANAURY   1988.  BOOTSTRAP SAMPLE
C     UPDATED         --AUGUST    1988.  (VARIANCE-COVARIANCE MATRIX)
C     UPDATED         --AUGUST    1988.  (CORRELATION MATRIX)
C     UPDATED         --AUGUST    1988.  (PRINCIPLE COMPONENTS)
C     UPDATED         --AUGUST    1988.  (... PRINCIPLE COMPONENTS)
C     UPDATED         --JANUARY   1989.  FIX A FORMAT STATEMENT (ALAN)
C     UPDATED         --NOVEMBER  1989.  FIX INTERPOLATION
C     UPDATED         --DECEMBER  1989.  (DEX) GENERATOR MULTIPLICATION
C     UPDATED         --JANUARY   1990.  SUBSAMPLE
C     UPDATED         --JULY      1991.  COCODE ('COCD')
C     UPDATED         --JULY      1991.  COCOPY ('COCP')
C     UPDATED         --FEBRUARY  1992.  FIX COCOPY ('COCP')
C     UPDATED         --MARCH     1992. EXT. SORT&CARRY TO MULTI ARGS
C     UPDATED         --MARCH     1992. ID IN ALL ERROR STATEMENTS
C     UPDATED         --APRIL     1992. SPLIT LONG FORMAT STATEMENTS
C     UPDATED         --MAY       1992. FIX IF .AND. IF
C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
C                     --MAY       1992.(SHOULD FOR POLARI,LOGARI,..?)
C     UPDATED         --JULY      1993. UPDATES FOR MATRIX CODE
C     UPDATED         --AUGUST    1993. UPDATES FOR MATRIX CODE
C     UPDATED         --SEPTEMBER 1993. UPDATES FOR MATRIX CODE
C     UPDATED         --SEPTEMBER 1993. FIX BUG FOR COMPLEX ROOTS
C     UPDATED         --OCTOBER   1993. JACNIFE INDEX
C     UPDATED         --OCTOBER   1993. ADDITIONAL MATRIX COMMANDS
C     UPDATED         --MAY       1994. LINEAR INTERPOLATE, 2D INTERPOL
C                                       BILINEAR INTERPOLATE, BIVARIATE
C                                       INTERPOLATE
C     UPDATED         --JUNE      1995. BUG IN MATRIX REPLACE ELEMENT
C     UPDATED         --AUGUST    1995. ZERO PADDING NO LONGER REQUIRED
C                                       FOR FFT.
C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE FEWER
C                                       MATRICES (AND THUS CAN HANDLE
C                                       LARGER MATRICES).
C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE
C                                       1-DIMENSIONAL SCRATCH ARRAYS
C                                       (WILL BE 2-D IN MATARI, MATAR2)
C     UPDATED         --MAY       1998. INTERARRIVAL TIMES CASE
C     UPDATED         --MAY       1998. CUMULATIVE AVERAGE CASE
C     UPDATED         --MAY       1998. REVERSE CASE
C     UPDATED         --MAY       1998. CUMULATIVE HAZARD CASE
C     UPDATED         --MAY       1998. HAZARD CASE
C     UPDATED         --SEPTEMBER 1998. EXPONENTIAL SMOOTHING
C     UPDATED         --JUNE      1998. SOME NEW MATRIX COMMANDS
C     UPDATED         --AUGUST    1998. MATRIX MEAN
C     UPDATED         --AUGUST    1998. MATRIX ADD ROW, MATRIX DELE ROW
C     UPDATED         --AUGUST    1998. DISTANCE FROM MEAN
C     UPDATED         --AUGUST    1998. FOR MATRIX COMMANDS, FIX HOW
C                                       SUBSETTING HANDLED WHEN OUTPUT
C                                       IS SAVED.  THE IUPFLG USED TO
C                                       CONTROL WHETHER OUTPUT IS SAVED
C                                       WITH SUBSETTING OR IS SAVED
C                                       AS A "FULL" MATRIX.  E.G.,
C                                       MATRIX ADDITION MAINTAINS THE
C                                       SUBSET WHEN SAVING THE OUTPUT,
C                                       WHILE CORRELATION MATRIX IS
C                                       SAVED AS A "FULL" MATRIX.
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP MEANS
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP SD
C     UPDATED         --SEPTEMBER 1998. POOLED VARIANCE-COVARIANCE
C                                       MATRIX (MORE THAN 2 GROUPS)
C     UPDATED         --OCTOBER   1998. SPLIT INTO 2 ROUTINES
C     UPDATED         --NOVEMBER  1998. BINNED COMMAND
C     UPDATED         --MARCH     2001. STANDARDIZE, LOCATION STAND
C     UPDATED         --SEPTEMBER 2001. CROSS TABULATE
C     UPDATED         --OCTOBER   2001. MATCH (A 2-VARIABLE AND
C                                       3-VARIABLE SYNTAX SUPPORTED)
C     UPDATED         --JULY      2002. WINSORIZE
C     UPDATED         --APRIL     2003. ARGUMENT LIST TO GRPSTA, GRPST2
C     UPDATED         --MAY       2003. STACK COMMAND
C     UPDATED         --SEPTEMBER 2004. ASH BIN
C     UPDATED         --SEPTEMBER 2004. COUNTS ASH BIN
C     UPDATED         --OCTOBER   2004. COMBINE FREQUENCY TABLE
C     UPDATED         --FEBRUARY  2005. H CONSISTENCY STATISTIC
C     UPDATED         --FEBRUARY  2005. K CONSISTENCY STATISTIC
C     UPDATED         --JUNE      2005. L MOMENTS
C     UPDATED         --JUNE      2005. PROBABILITY WEIGHTED MOMENTS
C     UPDATED         --DECEMBER  2005. BETA PROBABILITY WEIGHTED
C                                       MOMENTS
C     UPDATED         --DECEMBER  2005. SORT BY 
C     UPDATED         --DECEMBER  2005. SUBSTANTIAL REWRITE FOR
C                                       BETTER CLARITY (SIMILAR TO
C                                       CHANGES IN DPMAT2)
C     UPDATED         --FEBRUARY  2006. CALL LIST TO BIVAR FIXED
C     UPDATED         --FEBRUARY  2006. REPLACE
C     UPDATED         --MARCH     2006. CALL LIST TO DPBIN
C     UPDATED         --MAY       2006. INTEGER FREQUENCY TABLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASL7
      CHARACTER*4 ICASS7
      CHARACTER*4 ICASE
      CHARACTER*4 ICASE2
      CHARACTER*4 ICASMT
      CHARACTER*4 IFTEXP
      CHARACTER*4 IFTORD
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      PARAMETER(MAXCAS=30)
      PARAMETER(MAXCA2=3)
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWRITE
      CHARACTER*4 ITCASE
      CHARACTER*4 IACASE
      CHARACTER*4 IMSUBC
C
      CHARACTER*4 IHREPL
      CHARACTER*4 IHREP2
C
      CHARACTER*4 NEWNAM(MAXCA2)
      CHARACTER*4 ILEFT(MAXCA2)
      CHARACTER*4 ILEF2(MAXCA2)
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IMATSW
      CHARACTER*4 ITYP91
C
      CHARACTER*4 IHMAT1
      CHARACTER*4 IHMAT2
C
      CHARACTER*4 ITYPA(MAXCAS)
C
      CHARACTER*4 IHCV11
      CHARACTER*4 IHCV12
      CHARACTER*4 IHCV21
      CHARACTER*4 IHCV22
      CHARACTER*4 IHCV31
      CHARACTER*4 IHCV32
C
      CHARACTER*4 IUPFLG
      CHARACTER*4 IRELAT
      CHARACTER*4 IFLGLL
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 IHRIGH(MAXCAS)
      CHARACTER*4 IHRIG2(MAXCAS)
C
      INTEGER ILISL(MAXCA2)
      INTEGER ICOLL(MAXCA2)
      INTEGER ILOCR(MAXCAS)
      INTEGER ILISR(MAXCAS)
      INTEGER ICOLR(MAXCAS)
      INTEGER NIRIGH(MAXCAS)
      INTEGER NS(MAXCAS)
      REAL TEMPS(MAXCAS)
C
      DOUBLE PRECISION ATEMP
      DOUBLE PRECISION BTEMP
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION TEMP5(MAXOBV)
      DIMENSION TEMP12(2*MAXOBV)
      DIMENSION TEMP91(MAXOBV)
      DIMENSION TEMP92(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
      DIMENSION ITEMP2(MAXOBV)
      DIMENSION ITEMP3(MAXOBV)
      DIMENSION ITEMP4(MAXOBV)
      DIMENSION ITEMP5(MAXOBV)
      DIMENSION ITEMP6(MAXOBV)
      DOUBLE PRECISION DTEMP1(MAXOBV)
      DOUBLE PRECISION DTEMP2(MAXOBV)
      DOUBLE PRECISION DTEMP3(MAXOBV)
      COMPLEX TEMPC1
      DIMENSION TEMPC1(MAXOBV)
      DIMENSION TEMP6(5*MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (GARBAG(IGARB1),TEMP1)
      EQUIVALENCE (GARBAG(IGARB2),TEMP2)
      EQUIVALENCE (GARBAG(IGARB3),TEMP3)
      EQUIVALENCE (GARBAG(IGARB4),TEMP4)
      EQUIVALENCE (GARBAG(IGARB5),TEMP12)
      EQUIVALENCE (GARBAG(IGARB7),TEMP91)
      EQUIVALENCE (GARBAG(IGARB8),TEMP92)
      EQUIVALENCE (GARBAG(IGAR10),TEMP5)
      EQUIVALENCE (GARBAG(JGAR11),TEMPC1)
      EQUIVALENCE (GARBAG(JGAR13),TEMP6)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1)
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2)
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3)
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4)
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5)
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6)
      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1)
      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2)
      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
CCCCC DON'T PROCESS MATRIX COMMANDS.
C
      IF(ICASL7.EQ.'MAAD')GOTO19090
      IF(ICASL7.EQ.'MASU')GOTO19090
      IF(ICASL7.EQ.'MAMU')GOTO19090
      IF(ICASL7.EQ.'MASO')GOTO19090
      IF(ICASL7.EQ.'MAIN')GOTO19090
      IF(ICASL7.EQ.'MATR')GOTO19090
      IF(ICASL7.EQ.'MAAJ')GOTO19090
      IF(ICASL7.EQ.'MACE')GOTO19090
      IF(ICASL7.EQ.'MAEA')GOTO19090
      IF(ICASL7.EQ.'MAEE')GOTO19090
      IF(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.5)GOTO19090
      IF(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.6)GOTO19090
      IF(ICASL7.EQ.'MADE')GOTO19090
      IF(ICASL7.EQ.'MAPE')GOTO19090
      IF(ICASL7.EQ.'MASN')GOTO19090
      IF(ICASL7.EQ.'MASR')GOTO19090
      IF(ICASL7.EQ.'MANR')GOTO19090
      IF(ICASL7.EQ.'MANC')GOTO19090
      IF(ICASL7.EQ.'MASS')GOTO19090
      IF(ICASL7.EQ.'MATC')GOTO19090
      IF(ICASL7.EQ.'MASM')GOTO19090
      IF(ICASL7.EQ.'MAMI')GOTO19090
      IF(ICASL7.EQ.'MACF')GOTO19090
      IF(ICASL7.EQ.'MADF'.AND.NUMARG.EQ.7)GOTO19090
      IF(ICASL7.EQ.'MADF'.AND.NUMARG.EQ.8)GOTO19090
      IF(ICASL7.EQ.'MAEN')GOTO19090
      IF(ICASL7.EQ.'MARW')GOTO19090
      IF(ICASL7.EQ.'MAEL')GOTO19090
C
      IF(ICASL7.EQ.'MAVC')GOTO19090
      IF(ICASL7.EQ.'MACO')GOTO19090
      IF(ICASL7.EQ.'MAPC')GOTO19090
      IF(ICASL7.EQ.'MAP1')GOTO19090
      IF(ICASL7.EQ.'MAP2')GOTO19090
      IF(ICASL7.EQ.'MAP3')GOTO19090
      IF(ICASL7.EQ.'MAP4')GOTO19090
      IF(ICASL7.EQ.'MAP5')GOTO19090
      IF(ICASL7.EQ.'MAP6')GOTO19090
      IF(ICASL7.EQ.'MAP7')GOTO19090
      IF(ICASL7.EQ.'MAP8')GOTO19090
      IF(ICASL7.EQ.'MAP9')GOTO19090
      IF(ICASL7.EQ.'MA10')GOTO19090
      IF(ICASL7.EQ.'MASV')GOTO19090
      IF(ICASL7.EQ.'MASD')GOTO19090
      IF(ICASL7.EQ.'MASF')GOTO19090
      IF(ICASL7.EQ.'MACH')GOTO19090
      IF(ICASL7.EQ.'MAAU')GOTO19090
      IF(ICASL7.EQ.'MADI')GOTO19090
      IF(ICASL7.EQ.'MARR')GOTO19090
      IF(ICASL7.EQ.'MAAR')GOTO19090
      IF(ICASL7.EQ.'MADR')GOTO19090
      IF(ICASL7.EQ.'MAMM')GOTO19090
      IF(ICASL7.EQ.'MADM')GOTO19090
      IF(ICASL7.EQ.'DIMA')GOTO19090
      IF(ICASL7.EQ.'MAVT')GOTO19090
      IF(ICASL7.EQ.'MARE')GOTO19090
      IF(ICASL7.EQ.'MATD')GOTO19090
      IF(ICASL7.EQ.'MATS')GOTO19090
      IF(ICASL7.EQ.'MATI')GOTO19090
      IF(ICASL7.EQ.'MAIS')GOTO19090
      IF(ICASL7.EQ.'MQFO')GOTO19090
      IF(ICASL7.EQ.'MALC')GOTO19090
      IF(ICASL7.EQ.'MAGM')GOTO19090
      IF(ICASL7.EQ.'MAGS')GOTO19090
      IF(ICASL7.EQ.'MPIN')GOTO19090
      IF(ICASL7.EQ.'MHT1')GOTO19090
      IF(ICASL7.EQ.'MHT2')GOTO19090
      IF(ICASL7.EQ.'MPVC')GOTO19090
      IF(ICASL7.EQ.'MDER')GOTO19090
      IF(ICASL7.EQ.'MDEC')GOTO19090
      IF(ICASL7.EQ.'MDMR')GOTO19090
      IF(ICASL7.EQ.'MDMC')GOTO19090
      IF(ICASL7.EQ.'MDBR')GOTO19090
      IF(ICASL7.EQ.'MDBC')GOTO19090
      IF(ICASL7.EQ.'MDKR')GOTO19090
      IF(ICASL7.EQ.'MDKC')GOTO19090
      IF(ICASL7.EQ.'MDCR')GOTO19090
      IF(ICASL7.EQ.'MDCC')GOTO19090
      IF(ICASL7.EQ.'MRSC')GOTO19090
      IF(ICASL7.EQ.'MCSC')GOTO19090
      IF(ICASL7.EQ.'MDIP')GOTO19090
      IF(ICASL7.EQ.'MQRD')GOTO19090
      IF(ICASL7.EQ.'MROW')GOTO19090
      IF(ICASL7.EQ.'MCOL')GOTO19090
      IF(ICASL7.EQ.'MACA')GOTO19090
      IF(ICASL7.EQ.'MVRN')GOTO19090
      IF(ICASL7.EQ.'MURN')GOTO19090
      IF(ICASL7.EQ.'MPDF')GOTO19090
      IF(ICASL7.EQ.'WIRN')GOTO19090
      IF(ICASL7.EQ.'MTRN')GOTO19090
      IF(ICASL7.EQ.'IURN')GOTO19090
      IF(ICASL7.EQ.'DIRN')GOTO19090
      IF(ICASL7.EQ.'DPDF')GOTO19090
      IF(ICASL7.EQ.'DLPD')GOTO19090
      IF(ICASL7.EQ.'NCDF')GOTO19090
      IF(ICASL7.EQ.'TCDF')GOTO19090
      IF(ICASL7.EQ.'VINF')GOTO19090
      IF(ICASL7.EQ.'CIND')GOTO19090
      IF(ICASL7.EQ.'XTXI')GOTO19090
      IF(ICASL7.EQ.'CRMA')GOTO19090
      IF(ICASL7.EQ.'INRN')GOTO19090
      IF(ICASL7.EQ.'MSUM')GOTO19090
      IF(ICASL7.EQ.'MPAR')GOTO19090
      IF(ICASL7.EQ.'MGRA')GOTO19090
      IF(ICASL7.EQ.'MATB')GOTO19090
      IF(ICASL7.EQ.'MARB')GOTO19090
      IF(ICASL7.EQ.'MATZ')GOTO19090
      IF(ICASL7.EQ.'MAUZ')GOTO19090
C
      IUPFLG='SUBS'
C
      ISUBN1='DPMA'
      ISUBN2='TC  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      ILOCR(1)=ILOCV
      DO10I=2,MAXCAS
        ILOCR(I)=ILOCR(I-1)+1
        ITYPA(I)='VARI'
        TEMPS(I)=(-999.0)
        ILISR(I)=(-999)
        ICOLR(I)=(-999)
        NIRIGH(I)=(-999)
   10 CONTINUE
      DO15I=2,MAXCA2
        NEWNAM(I)='NO'
        ILISL(I)=(-999)
        ICOLL(I)=(-999)
   15 CONTINUE
C
      DO20I=1,MAXOBV
        ISUB(I)=1
   20 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMVAL=1
      SCAL91=(-999.0)
C
      IMATSW='NO'
      ICASMT='INDE'
      ITYP91='VECT'
C
C               ******************************************************
C               **  TREAT THE SUBCASE OF PERFORMING CERTAIN SPECIAL **
C               **  DATA MANIPULATIONS (SORT, RANK, CODE)           **
C               **       1) FOR A FULL VARIABLE, OR                 **
C               **       2) FOR PART OF A VARIABLE.                 **
C               ******************************************************
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMATC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,IBUGQ,ISUBRO
   52   FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASL7,ICASS7,ILOCV,NUMARG
   53   FORMAT('ICASL7,ICASS7,ILOCV,NUMARG = ',A4,2X,A4,2X,I8,2X,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)IFTEXP
   54   FORMAT('IFTEXP = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     ***************************************************************
C     **  STEP 2A--                                                 *
C     **  EXAMINE THE LEFT-HAND SIDE--                              *
C     **  IS THE VARIABLE NAME TO LEFT OF = SIGN                    *
C     **  ALREADY IN THE NAME LIST?    AS A VARIABLE?               *
C     **  NOTE THAT     ILEFT(I)   IS THE NAME OF THE VARIABLE      *
C     **  ON THE LEFT.                                              *
C     **  NOTE THAT     ILISL(I)  IS THE LINE IN THE TABLE          *
C     **  OF THE NAME ON THE LEFT.                                  *
C     **  NOTE THAT     ICOLL(I)  IS THE DATA COLUMN (1 TO 12)      *
C     **  FOR THE NAME OF THE LEFT.                                 *
C     ***************************************************************
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEZ=1
      CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
     1            ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1            NUMVAL,NIOLD,
     1            IBUGA3,ISUBRO,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C     FEBRUARY 2006: THE REPLACE COMMAND REQUIRES THAT THE
C                    LEFT-HAND SIDE VARIABLE ALREADY EXISTS.
C
      IF(ICASL7.EQ.'REPL')THEN
        IF(NEWNAM(ICASEZ).EQ.'YES')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,101)
  101     FORMAT('***** ERROR IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,103)
  103     FORMAT('      THE FIRST VARIABLE ON THE LEFT-HAND SIDE OF')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,105)ILEFT(ICASEZ),ILEF2(ICASEZ)
  105     FORMAT('      THE EQUAL SIGN, (',A4,A4,'), MUST ALREADY ',
     1           'EXIST.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,107)
  107     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSE
          NILEF1=NIOLD
        ENDIF
      ENDIF
C
      IF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
     1   ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1'.OR.
     1   ICASL7.EQ.'FFT'.OR.ICASL7.EQ.'BINN'.OR.
     1   ICASL7.EQ.'BINR'.OR.ICASL7.EQ.'CUMH'.OR.
     1   ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC'.OR.
CCCCC1   ICASL7.EQ.'MTCH'.OR.ICASL7.EQ.'HAZA'.OR.
CCCCC1   ICASL7.EQ.'FRAW'.OR.ICASL7.EQ.'FFT1'.OR.
     1   ICASL7.EQ.'FFT1'.OR.
     1   ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1'.OR.
     1   ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
     1   ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
     1   ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
     1   ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
     1   ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'PODI'.OR.
     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'FRAC'.OR.
     1   ICASL7.EQ.'STAC'.OR.ICASL7.EQ.'RSTA'.OR.
     1   ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'HCO2'.OR.
     1   ICASL7.EQ.'IFRT'.OR.
     1   ICASL7.EQ.'KCO2'.OR.ICASL7.EQ.'SRTB')THEN
C
        ICASEZ=2
        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1              NUMVAL,NIOLD,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(ICASL7.EQ.'CFRT' .OR.  ICASL7.EQ.'RSTA' .OR.
     1   ICASL7.EQ.'IFRT')THEN
        ICASEZ=3
        CALL DPMAT6(ICASL7,ICASEZ,MAXCA2,
     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1              NUMVAL,NIOLD,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,491)
  491   FORMAT('AT THE END OF STEP 2--')
        CALL DPWRST('XXX','BUG ')
        DO494I=1,MAXCA2
        WRITE(ICOUT,492)ILEFT(I),ILEF2(I),NEWNAM(I),NUMNAM,
     1                  ILISL(I),NUMCOL,ICOLL(I),NIOLD
        CALL DPWRST('XXX','BUG ')
  492   FORMAT('ILEFT(I),ILEFT(I),NEWNAM(I),NUMNAM,ILISL(I),',
     1         'NUMCOL,ICOLL(I),NIOLD = ',A4,A4,2X,A4,2X,5I8)
  494   CONTINUE
      ENDIF
C
C     ****************************************************************
C     **  STEP 4--                                                   *
C     **  EXAMINE THE RIGHT-HAND SIDE--                              *
C     **  HAS EACH VARIABLE ON THE RIGHT                             *
C     **  ALREADY BEEN DEFINED?                                      *
C     **  NOTE THAT     ILISR(1), ILISR(2), ILISR(3), ILISR(4)       *
C     **  IS THE LINE IN THE TABLE                                   *
C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
C     **  RESPECTIVELY.                                              *
C     **  NOTE THAT     ICOLR(1), ICOLR(2), ICOLR(3), ICOLR(4)       *
C     **  IS THE DATA COLUMN (1 TO 10+6)                             *
C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
C     **  RESPECTIVELY.                                              *
C     ****************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 4.1--                            **
C               **  DETERMINE THE NUMBER OF VARIABLES     **
C               **  ON THE RIGHT--1, 2, 3, OR 4           **
C               ********************************************
C
      ISTEPN='4.1'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMATSW='NO'
      NUMVAR=1
C
      IF(ICASL7.EQ.'FOU1'.OR.ICASL7.EQ.'IFO1'.OR.
     1   ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR'.OR.
     1   ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC'.OR.
     1   ICASL7.EQ.'FFT1'.OR.ICASL7.EQ.'IFF1'.OR.
     1   ICASL7.EQ.'COR1'.OR.ICASL7.EQ.'POSQ'.OR.
     1   ICASL7.EQ.'POSR'.OR.ICASL7.EQ.'VELE'.OR.
     1   ICASL7.EQ.'SECA'.OR.ICASL7.EQ.'SEEL'.OR.
     1   ICASL7.EQ.'IFRT'.OR.
     1   ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'WINS')THEN
        NUMVAR=1
      ELSEIF(ICASL7.EQ.'CONV'.OR.ICASL7.EQ.'DECO'.OR.
     1       ICASL7.EQ.'BOOT'.OR.ICASL7.EQ.'FREQ'.OR.
     1       ICASL7.EQ.'SUMD'.OR.ICASL7.EQ.'SUBS'.OR.
     1       ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'IFOU'.OR.
     1       ICASL7.EQ.'FFT' .OR.ICASL7.EQ.'CUMH'.OR.
     1       ICASL7.EQ.'HAZA'.OR.ICASL7.EQ.'FRAW'.OR.
     1       ICASL7.EQ.'EXPS'.OR.ICASL7.EQ.'IFFT'.OR.
     1       ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
     1       ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COCO'.OR.
     1       ICASL7.EQ.'POAD'.OR.ICASL7.EQ.'POSU'.OR.
     1       ICASL7.EQ.'POMU'.OR.ICASL7.EQ.'PODI'.OR.
     1       ICASL7.EQ.'POGC'.OR.ICASL7.EQ.'POLC'.OR.
     1       ICASL7.EQ.'POEV'.OR.ICASL7.EQ.'VEAD'.OR.
     1       ICASL7.EQ.'VESU'.OR.ICASL7.EQ.'VEDP'.OR.
     1       ICASL7.EQ.'VECP'.OR.ICASL7.EQ.'VEDI'.OR.
     1       ICASL7.EQ.'VEAN'.OR.ICASL7.EQ.'SEUN')THEN
        NUMVAR=2
      ELSEIF(ICASL7.EQ.'SEIN'.OR.ICASL7.EQ.'SECO'.OR.
     1       ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'LOAN'.OR.
     1       ICASL7.EQ.'LOOR'.OR.ICASL7.EQ.'LONA'.OR.
     1       ICASL7.EQ.'LONO'.OR.ICASL7.EQ.'LOIM'.OR.
     1       ICASL7.EQ.'LOEQ'.OR.ICASL7.EQ.'LOXO'.OR.
     1       ICASL7.EQ.'FRAC'.OR.ICASL7.EQ.'GEMU'.OR.
     1       ICASL7.EQ.'JAIN'.OR.ICASL7.EQ.'CFRT'.OR.
     1       ICASL7.EQ.'HCON'.OR.ICASL7.EQ.'KCON'.OR.
     1       ICASL7.EQ.'LMOM'.OR.ICASL7.EQ.'PWMO'.OR.
     1       ICASL7.EQ.'BPWM'.OR.ICASL7.EQ.'SRTB'.OR.
     1       ICASL7.EQ.'COCD')THEN
        NUMVAR=2
      ELSEIF(ICASL7.EQ.'INTR'.OR.ICASL7.EQ.'LINT'.OR.
     1       ICASL7.EQ.'HCO2'.OR.ICASL7.EQ.'KCO2'.OR.
     1       ICASL7.EQ.'COCP')THEN
        NUMVAR=3
      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI')THEN
        NUMVAR=4
      ELSEIF(ICASL7.EQ.'2DIN'.OR.ICASL7.EQ.'BILI'.OR.
     1       ICASL7.EQ.'BIVA')THEN
        NUMVAR=5
      ELSEIF(ICASL7.EQ.'SORC'.OR.ICASL7.EQ.'STAC'.OR.
     1       ICASL7.EQ.'RSTA'.OR.ICASL7.EQ.'MTCH'.OR.
     1       ICASL7.EQ.'STAN'.OR.ICASL7.EQ.'ZSCO'.OR.
     1       ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSTA'.OR.
     1       ICASL7.EQ.'LSST'.OR.ICASL7.EQ.'CRTA'.OR.
     1       ICASL7.EQ.'CUMI'.OR.ICASL7.EQ.'REPL'.OR.
     1       ICASL7(1:2).EQ.'CT')THEN
C
        ISTRT=ILOCV
        ILAST=NUMARG
        DO1051I=ISTRT,NUMARG
          IHRIGH(I)=IHARG(I)
          IHRIG2(I)=IHARG2(I)
          IF(IHRIGH(I).EQ.'SUBS'.AND.IHRIG2(I).EQ.'ET  ')THEN
            ILAST=I-1
            GOTO1054
          ELSEIF(IHRIGH(I).EQ.'EXCE'.AND.IHRIG2(I).EQ.'PT  ')THEN
            ILAST=I-1
            GOTO1054
          ELSEIF(IHRIGH(I).EQ.'FOR '.AND.IHRIG2(I).EQ.'    ')THEN
            ILAST=I-1
            GOTO1054
          ENDIF
 1051   CONTINUE
 1054   CONTINUE
        NUMVAR=ILAST-ISTRT+1
C
        IF(ICASL7.EQ.'MTCH' .OR. ICASL7.EQ.'REPL')THEN
          IF(NUMVAR.EQ.2)THEN
            ICASMT='INDE'
          ELSEIF(NUMVAR.EQ.3)THEN
            ICASMT='TRAN'
          ELSE
            IF(ICASL7.EQ.'MTCH')THEN
              WRITE(ICOUT,1061)
            ELSEIF(ICASL7.EQ.'REPL')THEN
              WRITE(ICOUT,1062)
            ENDIF
 1061       FORMAT('****** FOR THE MATCH COMMAND, THE NUMBER OF ',
     1             'VARIABLES TO THE RIGHT')
 1062       FORMAT('****** FOR THE REPLACE COMMAND, THE NUMBER OF ',
     1             'VARIABLES TO THE RIGHT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1063)NUMVAR
 1063       FORMAT('       MUST BE 2 OR 3.  ',I8,' VARIABLES FOUND.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ENDIF
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')THEN
        WRITE(ICOUT,1091)ICASL7,NUMVAR
 1091   FORMAT('ICASL7,NUMVAR = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************************
C               **  STEP 5.1--                       **
C               **  EXAMINE THE VARIABLES            **
C               **  ON THE RIGHT.                    **
C               ***************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG1=0
      IF(ICASL7.EQ.'JAIN')THEN
         IFLAG1=1
      ENDIF
      ICASEZ=1
      CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
     1IHRIGH(1),IHRIG2(1),ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1IFLAG1,ATEMP2,ITEMP,
     1IBUGA3,ISUBRO,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NUMVAR.GE.2)THEN
        IFLAG1=0
        IF(ICASL7.EQ.'LMOM' .OR. ICASL7.EQ.'PWMO' .OR.
     1     ICASL7.EQ.'BPWM' .OR. ICASL7.EQ.'JAIN' .OR.
     1     ICASL7.EQ.'EXPS' .OR. ICASL7.EQ.'MTCH')THEN
          IFLAG1=1
        ENDIF
        ICASEZ=2
        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
     1              IHRIGH(2),IHRIG2(2),ICOLR,ILISR,NIRIGH,
     1              ITYPA,TEMPS,
     1              IFLAG1,ATEMP2,ITEMP,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMVAR.GE.3)THEN
        IFLAG1=0
        ICASEZ=3
        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
     1              IHRIGH(3),IHRIG2(3),ICOLR,ILISR,NIRIGH,
     1              ITYPA,TEMPS,
     1              IFLAG1,ATEMP2,ITEMP,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMVAR.GE.4)THEN
        IFLAG1=0
        ICASEZ=4
        CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
     1              IHRIGH(4),IHRIG2(4),ICOLR,ILISR,NIRIGH,
     1              ITYPA,TEMPS,
     1              IFLAG1,ATEMP2,ITEMP,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C  5 OR MORE VARIABLES.
C
      IF(NUMVAR.GE.5)THEN
        IFLAG1=0
        DO1110ICASEZ=5,NUMVAR
          CALL DPMAT7(ICASL7,ICASEZ,MAXCAS,ILOCR,
     1                IHRIGH(ICASEZ),IHRIG2(ICASEZ),
     1                ICOLR,ILISR,NIRIGH,
     1                ITYPA,TEMPS,
     1                IFLAG1,ATEMP2,ITEMP,
     1                IBUGA3,ISUBRO,IFOUND,IERROR)
 1110   CONTINUE
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C
C               ******************************************************
C               **  STEP 6.1--                                      **
C               **  FOR CERTAIN 2-VARIABLE AND 3-VARIABLE CASES,    **
C               **  CHECK THAT VARIABLES 1 AND 2 HAVE THE SAME      **
C               **  NUMBER OF ELEMENTS.                             **
C               **  THIS CHECK IS NOT DONE FOR CONVOLUTION,         **
C               **  DECONVOLUTION, FREQUENCY                        **
C               **  AND SUM (DISTINCT)                              **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='6.1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  CASE 1: NO VARIABLES NEED TO BE SAME LENGTH
C
      IF(ICASL7.EQ.'CONV'.OR.ICASL7.EQ.'DECO'.OR.
     1   ICASL7.EQ.'FREQ'.OR.ICASL7.EQ.'SUMD'.OR.
     1   ICASL7.EQ.'SUBS'.OR.ICASL7.EQ.'POAD'.OR.
     1   ICASL7.EQ.'POSU'.OR.ICASL7.EQ.'POMU'.OR.
     1   ICASL7.EQ.'PODI'.OR.ICASL7.EQ.'POSQ'.OR.
     1   ICASL7.EQ.'POSR'.OR.ICASL7.EQ.'POGC'.OR.
     1   ICASL7.EQ.'POLC'.OR.ICASL7.EQ.'POEV'.OR.
     1   ICASL7.EQ.'SEUN'.OR.ICASL7.EQ.'SEIN'.OR.
     1   ICASL7.EQ.'SECO'.OR.ICASL7.EQ.'SECA'.OR.
     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'SEEL'.OR.
     1   ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'VELE'.OR.
     1   ICASL7.EQ.'GEMU'.OR.ICASL7.EQ.'COCD'.OR.
     1   ICASL7.EQ.'COCP'.OR.ICASL7.EQ.'EXPS'.OR.
     1   ICASL7.EQ.'MTCH'.OR.ICASL7.EQ.'STAC'.OR.
     1   ICASL7.EQ.'RSTA'.OR.ICASL7.EQ.'LMOM'.OR.
     1   ICASL7.EQ.'PWMO'.OR.ICASL7.EQ.'BPWM'.OR.
     1   NUMVAR.EQ.1)THEN
        GOTO2190
C
C  CASE 2: SAME LENGTH REQUIRED FOR VARIABLES 1 AND 2
C
      ELSEIF(ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
     1       ICASL7.EQ.'CORO'.OR.
     1       ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'CFRT'.OR.
     1       ICASL7.EQ.'VEAD'.OR.ICASL7.EQ.'VESU'.OR.
     1       ICASL7.EQ.'VEDP'.OR.ICASL7.EQ.'VECP'.OR.
     1       ICASL7.EQ.'VEDI'.OR.ICASL7.EQ.'VEAN'.OR.
     1       ICASL7.EQ.'LOAN'.OR.ICASL7.EQ.'LOOR'.OR.
     1       ICASL7.EQ.'LONA'.OR.ICASL7.EQ.'LONO'.OR.
     1       ICASL7.EQ.'LOIM'.OR.ICASL7.EQ.'LOEQ'.OR.
     1       ICASL7.EQ.'LOXO'.OR.ICASL7.EQ.'HCON'.OR.
     1       ICASL7.EQ.'KCON'.OR.ICASL7.EQ.'SRTB'.OR.
     1       (ICASL7.EQ.'ZSCO'.OR.ICASL7.EQ.'LSTA'.OR.
     1        ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSST'.OR.
     1        ICASL7.EQ.'CRTA'.OR.ICASL7.EQ.'STAN'.OR.
     1        ICASL7(1:2).EQ.'CT' .AND. NUMVAR.EQ.2))THEN
        IF(NIRIGH(1).NE.NIRIGH(2))THEN
          WRITE(ICOUT,2111)
 2111     FORMAT('***** ERROR 2111 IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2112)
 2112     FORMAT('      VARIABLES ONE AND TWO MUST HAVE THE SAME')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2113)
 2113     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
     1           'THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          DO2114J=1,2
            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
 2115       FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1             ' OBSERVATIONS;')
            CALL DPWRST('XXX','BUG ')
 2114     CONTINUE
          WRITE(ICOUT,2118)
 2118     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
 2119       FORMAT('      ',100A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO19000
        ENDIF
C
C  CASE 3: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, AND 3
C
      ELSEIF(ICASL7.EQ.'HCO2'.OR.ICASL7.EQ.'KCO2'.OR.
     1       ICASL7.EQ.'2DIN' .OR.
     1       (ICASL7.EQ.'ZSCO'.OR.ICASL7.EQ.'LSTA'.OR.
     1       ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSST'.OR.
     1       ICASL7.EQ.'CRTA'.OR.ICASL7.EQ.'STAN'.OR.
     1       ICASL7(1:2).EQ.'CT' .AND. NUMVAR.EQ.3))THEN
        IF(NIRIGH(1).NE.NIRIGH(2) .OR. NIRIGH(1).NE.NIRIGH(3))THEN
          WRITE(ICOUT,2121)
 2121     FORMAT('***** ERROR 2121 IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2122)
 2122     FORMAT('      VARIABLES ONE , TWO, AND THREE MUST HAVE ',
     1           'THE SAME')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2123)
 2123     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
     1           'THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          DO2124J=1,3
            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
            CALL DPWRST('XXX','BUG ')
 2124     CONTINUE
          WRITE(ICOUT,2118)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO19000
        ENDIF
C
C  CASE 4: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, 3, AND 4
C
      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI')THEN
        IF(NIRIGH(1).NE.NIRIGH(2) .OR. NIRIGH(1).NE.NIRIGH(3) .OR.
     1     NIRIGH(1).NE.NIRIGH(4))THEN
          WRITE(ICOUT,2131)
 2131     FORMAT('***** ERROR 2131 IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2132)
 2132     FORMAT('      VARIABLES ONE , TWO, THREE, AND FOUR ',
     1           'MUST HAVE THE SAME')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2133)
 2133     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
     1           'THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          DO2134J=1,4
            WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
            CALL DPWRST('XXX','BUG ')
 2134     CONTINUE
          WRITE(ICOUT,2136)IHRIGH(1),IHRIG2(1),NIRIGH(1)
 2136     FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1           ' OBSERVATIONS;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2136)IHARG(ILOCV+1),IHARG2(ILOCV+1),NIRIGH(2)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2136)IHARG(ILOCV+2),IHARG2(ILOCV+2),NIRIGH(3)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2136)IHARG(ILOCV+3),IHARG2(ILOCV+3),NIRIGH(4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2118)
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO19000
        ENDIF
C
C  CASE 5: SAME LENGTH REQUIRED FOR VARIABLES 1, 2, AND 3 AND
C          FOR VARIABLES 4 AND 5
C
      ELSEIF(ICASL7.EQ.'BILI'.OR.ICASL7.EQ.'BIVA')THEN
        IF(NIRIGH(1).EQ.NIRIGH(2).AND.NIRIGH(2).EQ.NIRIGH(3).AND.
     1     NIRIGH(4).EQ.NIRIGH(5))GOTO2190
        WRITE(ICOUT,2141)
 2141   FORMAT('***** ERROR 2141 IN DPMATC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2142)
 2142   FORMAT('      FOR 2D INTERPOLATION, THE NUMBER OF ',
     1         'OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2143)
 2143   FORMAT('     IN THE FIRST THREE VARIABLES AND IN VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2144)
 2144   FORMAT('      4 AND 5 MUST BE THE SAME; SUCH WAS NOT THE ',
     1         'CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        DO2146J=1,5
          WRITE(ICOUT,2115)IHRIGH(J),IHRIG2(J),NIRIGH(J)
          CALL DPWRST('XXX','BUG ')
 2146   CONTINUE
        WRITE(ICOUT,2118)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO19000
C
C  CASE 6: VARIABLE 1 AND VARIABLE 3 MUST HAVE SAME LENGTH
C
      ELSEIF((ICASL7.EQ.'MTCH'.AND.ICASMT.EQ.'TRAN') .OR.
     1       (ICASL7.EQ.'REPL'.AND.ICASMT.EQ.'TRAN'))THEN
        IF(NIRIGH(1).NE.NIRIGH(3))THEN
          WRITE(ICOUT,2151)
 2151     FORMAT('***** ERROR 2151 IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2152)
 2152     FORMAT('      VARIABLES ONE AND THREE MUST HAVE THE SAME')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2153)
 2153     FORMAT('      NUMBER OF OBSERVATIONS;  SUCH WAS NOT ',
     1           'THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2115)IHRIGH(1),IHRIG2(1),NIRIGH(1)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2115)IHRIGH(3),IHRIG2(3),NIRIGH(3)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,2158)
 2158     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,2119)(IANS(I),I=1,MAX(100,IWIDTH))
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO19000
        ENDIF
      ENDIF
C
 2190 CONTINUE
C
C               *******************************
C               **  STEP 7--                 **
C               **  DETERMINE THE SUBCASE    **
C               **  AND BRANCH ACCORDINGLY.  **
C               *******************************
C
 7000 CONTINUE
C
      ISTEPN='7'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,7003)NUMVAR,NUMARG
 7003   FORMAT('7008--NUMVAR,NUMARG = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO7005I=1,NUMVAR
        WRITE(ICOUT,7008)I,ITYPA(I),ILOCR(I)
 7008   FORMAT('7008-I,ITYPA(I),ILOCR(I) = ',I4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
 7005   CONTINUE
        WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR))
 7006   FORMAT('IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR)) = ',2A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
     1                   IHARG2(ILOCR(NUMVAR)+1)
 7007   FORMAT('IHARG(ILOCR(NUMVAR)+1),IHARG2(ILOCR(NUMVAR)+1) = ',
     1         2A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC FOR EXPONENTIAL SMOOTH, SECOND ARGUMENT OPTIONAL.
C
      IF(ICASL7.EQ.'EXPS')THEN
        IF(ILOCR(1).EQ.NUMARG)THEN
          TEMPS(2)=0.0
          NUMVAR=1
          GOTO8000
        ELSEIF(IHARG(ILOCR(2)).EQ.'SUBS'.OR.
     1         IHARG(ILOCR(2)).EQ.'EXCE'.OR.
     1         IHARG(ILOCR(2)).EQ.'FOR ')THEN
          TEMPS(2)=0.0
          NUMVAR=1
          IF(IHARG(ILOCR(2)).EQ.'SUBS')GOTO9000
          IF(IHARG(ILOCR(2)).EQ.'EXCE')GOTO9000
          IF(IHARG(ILOCR(2)).EQ.'FOR ')GOTO10000
        ENDIF
      ELSEIF(ICASL7.EQ.'SORC' .OR. ICASL7.EQ.'STAC'.OR.
     1       ICASL7.EQ.'RSTA')THEN
        NUMVAR=1
        ISTRT=4
        IF(ICASL7.EQ.'STAC')ISTRT=5
        IF(ICASL7.EQ.'RSTA')ISTRT=7
        IF(NUMARG.LE.ISTRT)GOTO8000
        DO7051I=ISTRT+1,NUMARG
          ILOCR7=I
          NUMVAR=NUMVAR+1
          IF(ILOCR7.GE.NUMARG)GOTO8000
          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'SUBS'.AND.
     1       IHARG2(ILOCR7+1).EQ.'ET  ')GOTO9000
          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'EXCE'.AND.
     1       IHARG2(ILOCR7+1).EQ.'PT  ')GOTO9000
          IF(ILOCR7.LT.NUMARG.AND.IHARG(ILOCR7+1).EQ.'FOR '.AND.
     1       IHARG2(ILOCR7+1).EQ.'    ')GOTO10000
 7051   CONTINUE
        GOTO8000
      ENDIF
C
      IF(ILOCR(NUMVAR).EQ.NUMARG)GOTO8000
C
      IF(ILOCR(NUMVAR).LT.NUMARG)THEN
        IT1=ILOCR(NUMVAR+1)
        IF(IHARG(IT1).EQ.'SUBS'.AND.IHARG2(IT1).EQ.'ET  ')GOTO9000
        IF(IHARG(IT1).EQ.'EXCE'.AND.IHARG2(IT1).EQ.'PT  ')GOTO9000
        IF(IHARG(IT1).EQ.'FOR '.AND.IHARG2(IT1).EQ.'    ')GOTO10000
      ENDIF
C
      WRITE(ICOUT,7081)
 7081 FORMAT('***** ERROR 7081 IN DPMATC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7082)
 7082 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7082--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7083)
 7083 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7084)(IANS(I),I=1,MAX(100,IWIDTH))
 7084 FORMAT(100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7088)ILOCV,NUMARG,NUMVAR
 7088 FORMAT('ILOCV,NUMARG,NUMVAR = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO7089I=1,NUMVAR
      WRITE(ICOUT,7086)I,ILOCR(I)
 7086 FORMAT('I,ILOCR(I) = ',I4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 7089 CONTINUE
      IERROR='YES'
      GOTO19000
C
C               ************************************************
C               **  STEP 8--                                  **
C               **  TREAT THE FULL VARIABLE CASE.             **
C               **  EXAMPLE--LET Y = SORT X                   **
C               **         --LET Y(I) = SORT X                **
C               **  THEN JUMP TO STEP NUMBER 10 BELOW         **
C               **  FOR THE LIST UPDATING AND                 **
C               **  FOR SOME INFORMATIVE PRINTING.            **
C               ************************************************
C
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,8011)NUMVAR,NIRIGH(1)
 8011   FORMAT('NUMVAR,NIRIGH(1) = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICASEQ='FULL'
      NIOLD=NIRIGH(1)
      IF(NUMVAR.GE.2)THEN
        DO8020I=2,NUMVAR
          IF(NIRIGH(I).GT.NIOLD)NIOLD=NIRIGH(I)
 8020   CONTINUE
      ENDIF
      NINEW=NIOLD
      DO8100I=1,NINEW
        ISUB(I)=1
 8100 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,8021)NINEW,NIRIGH(1)
 8021   FORMAT('NINEW,NIRIGH(1) = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO11000
C
C               **************************************************
C               **  STEP 9--                                     *
C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.      *
C               **  EXAMPLE--LET Y = SORT X     SUBSET 2 3 5     *
C               **         --LET Y(I) = SORT X  SUBSET 2 3 5     *
C               **  JUMP TO STEP NUMBER 11 BELOW                 *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,       *
C               **  FOR THE LIST UPDATING, AND                   *
C               **  FOR SOME INFORMATIVE PRINTING.               *
C               **************************************************
C
 9000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='SUBS'
      ILOCSV=ILOCR(NUMVAR)+2
      IHSET=IHARG(ILOCSV)
      IHSET2=IHARG2(ILOCSV)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,9002)ILOCSV,IHSET,IHSET2
 9002   FORMAT('ILOCSV,IHSET,IHSET2 = ',I8,2X,A4,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      NIOLD=IN(ILOC)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NINEW=NIOLD
      GOTO11000
C
C               **************************************************
C               **  STEP 10--                                    *
C               **  TREAT THE PARTIAL VARIABLE FOR CASE.         *
C               **  EXAMPLE--LET Y = SORT X     FOR I = 1 2 10   *
C               **         --LET Y(I) = SORT X  FOR I = 1 2 10   *
C               **  JUMP TO STEP NUMBER 11 BELOW                 *
C               **  FOR THE ACTUAL MATHEMATICAL OPERATION,       *
C               **  FOR THE LIST UPDATING, AND                   *
C               **  FOR SOME INFORMATIVE PRINTING.               *
C               **************************************************
C
10000 CONTINUE
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FOR'
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIFOR=NINEW
      GOTO11000
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE                        **
C               **  MATHEMATICAL OPERATION.              **
C               *******************************************
C
11000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        DO11109I=1,NUMVAR
          WRITE(ICOUT,11101)I,ITYPA(I)
11101     FORMAT('11101--I,ITYPA(I) = ',I4,2X,A4)
          CALL DPWRST('XXX','BUG ')
11109   CONTINUE
      ENDIF
C
      NITEMX=NINEW
      NS1=0
      NS2=0
      NS3=0
      NS4=0
      NS5=0
C
      IF(NUMVAR.GE.1 .AND. ITYPA(1).EQ.'VARI')THEN
        DO11111I=1,NINEW
          IF(ISUB(I).EQ.0)GOTO11111
          IF(I.GT.NIRIGH(1))GOTO11119
          IJ=MAXN*(ICOLR(1)-1)+I
C
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')THEN
            WRITE(ICOUT,11112)I,NS1,NINEW,ISUB(I),IJ,V(IJ)
11112       FORMAT('I,NS1,NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          NS1=NS1+1
          IF(ICOLR(1).LE.MAXCOL)TEMP1(NS1)=V(IJ)
          IF(ICOLR(1).EQ.MAXCP1)TEMP1(NS1)=PRED(I)
          IF(ICOLR(1).EQ.MAXCP2)TEMP1(NS1)=RES(I)
          IF(ICOLR(1).EQ.MAXCP3)TEMP1(NS1)=YPLOT(I)
          IF(ICOLR(1).EQ.MAXCP4)TEMP1(NS1)=XPLOT(I)
          IF(ICOLR(1).EQ.MAXCP5)TEMP1(NS1)=X2PLOT(I)
          IF(ICOLR(1).EQ.MAXCP6)TEMP1(NS1)=TAGPLO(I)
11111   CONTINUE
11119   CONTINUE
      ENDIF
C
      IF(NUMVAR.GE.2 .AND. ITYPA(2).EQ.'VARI')THEN
        DO11121I=1,NINEW
          IF(ISUB(I).EQ.0)GOTO11121
          IF(I.GT.NIRIGH(2))GOTO11129
          NS2=NS2+1
          IJ=MAXN*(ICOLR(2)-1)+I
          IF(ICOLR(2).LE.MAXCOL)TEMP2(NS2)=V(IJ)
          IF(ICOLR(2).EQ.MAXCP1)TEMP2(NS2)=PRED(I)
          IF(ICOLR(2).EQ.MAXCP2)TEMP2(NS2)=RES(I)
          IF(ICOLR(2).EQ.MAXCP3)TEMP2(NS2)=YPLOT(I)
          IF(ICOLR(2).EQ.MAXCP4)TEMP2(NS2)=XPLOT(I)
          IF(ICOLR(2).EQ.MAXCP5)TEMP2(NS2)=X2PLOT(I)
          IF(ICOLR(2).EQ.MAXCP6)TEMP2(NS2)=TAGPLO(I)
11121   CONTINUE
11129   CONTINUE
      ENDIF
C
      IF(NUMVAR.GE.3 .AND. ITYPA(3).EQ.'VARI')THEN
        DO11131I=1,NIRIGH(3)
          IF(ISUB(I).EQ.0)GOTO11131
          IF(I.GT.NIRIGH(3))GOTO11139
          NS3=NS3+1
          IJ=MAXN*(ICOLR(3)-1)+I
          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
11131   CONTINUE
11139   CONTINUE
      ENDIF
C
      IF(NUMVAR.GE.4 .AND. ITYPA(4).EQ.'VARI')THEN
        DO11141I=1,NIRIGH(4)
          IF(ISUB(I).EQ.0)GOTO11141
          IF(I.GT.NIRIGH(4))GOTO11149
          NS4=NS4+1
          IJ=MAXN*(ICOLR(4)-1)+I
          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
11141   CONTINUE
11149   CONTINUE
      ENDIF
C
      IF(NUMVAR.GE.5 .AND. ITYPA(5).EQ.'VARI')THEN
        DO11151I=1,NIRIGH(5)
          IF(ISUB(I).EQ.0)GOTO11151
          IF(I.GT.NIRIGH(5))GOTO11159
          NS5=NS5+1
          IJ=MAXN*(ICOLR(5)-1)+I
          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
11151   CONTINUE
11159   CONTINUE
      ENDIF
C
11290 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
        WRITE(ICOUT,11292)NINEW,ICASL7,ICASEQ
11292   FORMAT('11292--NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11293)NS1,NS2,NS3,NS4,NS5
11293   FORMAT('NS1,NS2,NS3,NS4,NS5 = ',5I8)
        CALL DPWRST('XXX','BUG ')
        DO11294II=1,4
          WRITE(ICOUT,11291)II,ICOLR(II),ITYPA(II)
11291     FORMAT('II,ICOLR(II),ITYPA(II) = ',I8,2X,I8,2X,A4)
          CALL DPWRST('XXX','BUG ')
11294   CONTINUE
        WRITE(ICOUT,11296)IMATSW,ICASL7
11296   FORMAT('IMATSW,ICASL7 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     -----BRANCH TO THE PROPER CASE-----
C
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
      IF(ICASL7.EQ.'SORT')THEN
        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
          DO11310I=1,NS1
            WRITE(ICOUT,11311)I,TEMP1(I)
11311       FORMAT('I,TEMP1(I) = ',I8,2X,F10.5)
            CALL DPWRST('XXX','BUG ')
11310     CONTINUE
        ENDIF
        CALL SORT(TEMP1,NS1,TEMP1)
CCCCC   CHECK DIRECTION.  JANUARY 2000.
        IF(ISORDI.EQ.'DESC')THEN
          DO11315I=1,NS1
            TEMP2(I)=TEMP1(I)
11315     CONTINUE
          DO11317I=1,NS1
            II=NS1-I+1
            TEMP1(I)=TEMP2(II)
11317     CONTINUE
        ENDIF
        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
          DO11312I=1,NS1
            WRITE(ICOUT,11311)I,TEMP1(I)
            CALL DPWRST('XXX','BUG ')
11312     CONTINUE
        ENDIF
      ELSEIF(ICASL7.EQ.'RANK')THEN
        CALL RANK2(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'CODE')THEN
        CALL CODE(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'DIST')THEN
        CALL DISTIN(TEMP1,NS1,IWRITE,TEMP1,NITEMX,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'SEQD')THEN
        CALL SEQDIF(TEMP1,NS1,IWRITE,TEMP1,NITEMX,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'IART')THEN
        CALL INTARR(TEMP1,NS1,IWRITE,TEMP1,NITEMX,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'CUMS')THEN
        CALL CUMSUM(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'CUMA')THEN
        CALL CUMAVE(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'CUMH')THEN
        CALL CUMHAZ(TEMP1,TEMP2,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'HAZA')THEN
        CALL HAZARD(TEMP1,TEMP2,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'EXPS')THEN
        IF(TEMPS(2).GT.0.0.AND.TEMPS(2).LT.1.0)THEN
          CALL EXPSMO(TEMP1,TEMP2,TEMPS(2),TEMPS(3),NS1,IWRITE,TEMP1,
     1                IBUGA3,IERROR)
        ELSE
          CALL EXPSM2(TEMP1,TEMP2,TEMPS(2),TEMPS(3),NS1,IWRITE,TEMP3,
     1                IBUGA3,IERROR)
          DO1185I=1,NS1
            TEMP1(I)=TEMP3(I)
 1185     CONTINUE
        ENDIF
C
        IH='ALPH'
        IH2='A   '
        VALUE0=TEMPS(2)
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='EXPS'
        IH2='MSE '
        VALUE0=TEMPS(3)
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1              IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1              IANS,IWIDTH,IBUGA3,IERROR)
C
      ELSEIF(ICASL7.EQ.'CUMP')THEN
        CALL CUMPRO(TEMP1,NS1,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'CUMI')THEN
        CALL CUMINT(TEMP1,TEMP2,NS1,NUMVAR,IWRITE,TEMP1,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'FLIP')THEN
        CALL REVERS(TEMP1,NS1,IWRITE,TEMP1,TEMP2,IBUGA3,IERROR)
      ELSEIF(ICASL7.EQ.'MTCH')THEN
        CALL MATCH(TEMP1,TEMP3,NS1,TEMP2,NS2,IWRITE,TEMP4,ICASMT,
     1             IBUGA3,IERROR)
        NITEMX=NS2
        DO11373I=1,NITEMX
          TEMP1(I)=TEMP4(I)
11373   CONTINUE
      ELSEIF(ICASL7.EQ.'REPL')THEN
C
C       FOR REPLACE COMMAND, NEED TO INSERT THE CURRENTLY DEFINED
C       VALUES FOR THE FIRST LEFT-HAND SIDE VARIABLE IN TEMP4.
C
        NS1SAV=NS1
        NS1=0
        DO11381I=1,NINEW
          IF(ISUB(I).EQ.0)GOTO11381
          IF(I.GT.NILEF1)GOTO11389
          IJ=MAXN*(ICOLL(1)-1)+I
          NS1=NS1+1
          IF(ICOLL(1).LE.MAXCOL)TEMP4(NS1)=V(IJ)
          IF(ICOLL(1).EQ.MAXCP1)TEMP4(NS1)=PRED(I)
          IF(ICOLL(1).EQ.MAXCP2)TEMP4(NS1)=RES(I)
          IF(ICOLL(1).EQ.MAXCP3)TEMP4(NS1)=YPLOT(I)
          IF(ICOLL(1).EQ.MAXCP4)TEMP4(NS1)=XPLOT(I)
          IF(ICOLL(1).EQ.MAXCP5)TEMP4(NS1)=X2PLOT(I)
          IF(ICOLL(1).EQ.MAXCP6)TEMP4(NS1)=TAGPLO(I)
11381   CONTINUE
11389   CONTINUE
        NS1=NS1SAV
        CALL REPLAC(TEMP1,TEMP3,NS1,TEMP2,NS2,IWRITE,TEMP4,ICASMT,
     1              ISUBRO,IBUGA3,IERROR)
        NITEMX=NS1
        DO11383I=1,NITEMX
          TEMP1(I)=TEMP4(I)
11383   CONTINUE
C
      ELSEIF(ICASL7.EQ.'CONV')THEN
        CALL CONVOL(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,MAXN,
     1              TEMP91,NITEMX,IBUGA3,IERROR)
        DO11395I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11395   CONTINUE
      ELSEIF(ICASL7.EQ.'DECO')THEN
        CALL DECONV(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
     1              TEMP91,NITEMX,IBUGA3,IERROR)
        DO11405I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11405   CONTINUE
      ELSEIF(ICASL7.EQ.'SORC')THEN
        CALL SORTI(TEMP1,NS1,TEMP1,TEMP91)
        IF(ISORDI.EQ.'DESC')THEN
          DO31411I=1,NS1
            TEMP4(I)=TEMP1(I)
31411     CONTINUE
          DO31412I=1,NS1
            II=NS1-I+1
            TEMP1(I)=TEMP4(II)
31412     CONTINUE
        ENDIF
C
        IF(IBUGA3.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11411)(TEMP1(I),TEMP91(I),I=1,NS1)
11411     FORMAT(F10.5,2X,F10.5)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NUMARG.LE.4)GOTO11418
          DO11412ILOCRI=5,NUMARG
            IH1=IHARG(ILOCRI)
            IH2=IHARG2(ILOCRI)
            IF(IH1.EQ.'SUBS'.AND.IH2.EQ.'ET  ')GOTO11418
            IF(IH1.EQ.'EXCE'.AND.IH2.EQ.'PT  ')GOTO11418
            IF(IH1.EQ.'FOR '.AND.IH2.EQ.'    ')GOTO11418
            IHWUSE='V'
            MESSAG='YES'
            CALL CHECKN(IH1,IH2,IHWUSE,
     1           IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1           ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
            IF(IERROR.EQ.'YES')GOTO19000
            ICOLRI=IVALUE(ILOC)
            NITEMP=IN(ILOC)
C
            CALL DPSUBS(NITEMP,ILOCS,NS,IBUGQ,IERROR)
C
            NR=0
            DO11413I=1,NITEMP
              IF(ISUB(I).EQ.0)GOTO11413
              NR=NR+1
              IJ=MAXN*(ICOLRI-1)+NR
              IF(ICOLRI.LE.MAXCOL)TEMP2(NR)=V(IJ)
              IF(ICOLRI.EQ.MAXCP1)TEMP2(NR)=PRED(I)
              IF(ICOLRI.EQ.MAXCP2)TEMP2(NR)=RES(I)
              IF(ICOLRI.EQ.MAXCP3)TEMP2(NR)=YPLOT(I)
              IF(ICOLRI.EQ.MAXCP4)TEMP2(NR)=XPLOT(I)
              IF(ICOLRI.EQ.MAXCP5)TEMP2(NR)=X2PLOT(I)
              IF(ICOLRI.EQ.MAXCP6)TEMP2(NR)=TAGPLO(I)
11413       CONTINUE
C
            DO11414I=1,NR
              J=TEMP91(I)+0.5
              TEMP3(I)=TEMP2(J)
11414       CONTINUE
            IF(ISORDI.EQ.'DESC')THEN
              DO11416I=1,NR
                TEMP4(I)=TEMP3(I)
11416         CONTINUE
              DO11419I=1,NR
                II=NR-I+1
                TEMP3(I)=TEMP4(II)
11419         CONTINUE
            ENDIF
C
            J=0
            DO11415I=1,NITEMP
              IF(ISUB(I).EQ.0)GOTO11415
              J=J+1
              IJ=MAXN*(ICOLRI-1)+I
              IF(ICOLRI.LE.MAXCOL)V(IJ)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP1)PRED(I)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP2)RES(I)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP3)YPLOT(I)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP4)XPLOT(I)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP5)X2PLOT(I)=TEMP3(J)
              IF(ICOLRI.EQ.MAXCP6)TAGPLO(I)=TEMP3(J)
11415       CONTINUE
11412     CONTINUE
11418   CONTINUE
C
CCCCC THE FOLLOWING STACK SECTION ADDED MAY 2003
CCCCC FEBRUARY 2005: ADD SUPPORT FOR REPLICATED STACK.  IN THIS
CCCCC                CASE, LAST VARIABLE IS A REPLICATION NUMBER
CCCCC                THAT WILL BE DUPLICATED FOR EACH GROUP.
C
      ELSEIF(ICASL7.EQ.'STAC' .OR. ICASL7.EQ.'RSTA')THEN
        IF(NUMARG.LE.4)GOTO91499
        IF(ICASL7.EQ.'RSTA' .AND. NUMARG.LE.6)GOTO91499
C
        ICNT=0
        IVARCN=0
        NLAST=NUMARG
        NSTRT=5
        IF(ICASL7.EQ.'RSTA')NSTRT=7
        IF(ICASL7.EQ.'RSTA')THEN
          NLAST=NUMARG-1
          DO91403II=NSTRT,NUMARG
            IH1=IHARG(II)
            IH2=IHARG2(II)
            IF(IH1.EQ.'SUBS'.AND.IH2.EQ.'ET  ')THEN
              NLAST=II-1
              GOTO91407
            ELSEIF(IH1.EQ.'EXCE'.AND.IH2.EQ.'PT  ')THEN
              NLAST=II-1
              GOTO91407
            ELSEIF(IH1.EQ.'FOR '.AND.IH2.EQ.'    ')THEN
              NLAST=II-1
              GOTO91407
            ENDIF
91403     CONTINUE
91407     CONTINUE
          NREPL=NLAST+1
        ENDIF
C
        DO91412ILOCRI=NSTRT,NLAST
C
          IF(ICASL7.EQ.'RSTA')THEN
            IHREPL=IHARG(NREPL)
            IHREP2=IHARG2(NREPL)
            IF(IHREPL.EQ.'SUBS'.AND.IHREP2.EQ.'ET  ')GOTO91499
            IF(IHREPL.EQ.'EXCE'.AND.IHREP2.EQ.'PT  ')GOTO91499
            IF(IHREPL.EQ.'FOR '.AND.IHREP2.EQ.'    ')GOTO91499
            IHWUSE='V'
            MESSAG='YES'
            CALL CHECKN(IHREPL,IHREP2,IHWUSE,
     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,
     1                  NUMNAM,MAXNAM,
     1                  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
            IF(IERROR.EQ.'YES')GOTO19000
            ICOLRP=IVALUE(ILOC)
            NIREPL=IN(ILOC)
          ENDIF
C
          IHREPL=IHARG(ILOCRI)
          IHREP2=IHARG2(ILOCRI)
          IF(IHREPL.EQ.'SUBS'.AND.IHREP2.EQ.'ET  ')GOTO91499
          IF(IHREPL.EQ.'EXCE'.AND.IHREP2.EQ.'PT  ')GOTO91499
          IF(IHREPL.EQ.'FOR '.AND.IHREP2.EQ.'    ')GOTO91499
          IHWUSE='V'
          MESSAG='YES'
          CALL CHECKN(IHREPL,IHREP2,IHWUSE,
     1         IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1         ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
          IF(IERROR.EQ.'YES')GOTO19000
          ICOLRI=IVALUE(ILOC)
          NITEMP=IN(ILOC)
          IVARCN=IVARCN+1
C
          CALL DPSUBS(NITEMP,ILOCS,NS,IBUGQ,IERROR)
C
          NR=0
          DO91413I=1,NITEMP
            IF(ISUB(I).EQ.0)GOTO91413
            NR=NR+1
            IJ=MAXN*(ICOLRI-1)+NR
            IF(ICOLRI.LE.MAXCOL)ATEMP=V(IJ)
            IF(ICOLRI.EQ.MAXCP1)ATEMP=PRED(I)
            IF(ICOLRI.EQ.MAXCP2)ATEMP=RES(I)
            IF(ICOLRI.EQ.MAXCP3)ATEMP=YPLOT(I)
            IF(ICOLRI.EQ.MAXCP4)ATEMP=XPLOT(I)
            IF(ICOLRI.EQ.MAXCP5)ATEMP=X2PLOT(I)
            IF(ICOLRI.EQ.MAXCP6)ATEMP=TAGPLO(I)
C
            IF(ICASL7.EQ.'RSTA')THEN
              IJ=MAXN*(ICOLRP-1)+NR
              IF(ICOLRP.LE.MAXCOL)ATEMP2=V(IJ)
              IF(ICOLRP.EQ.MAXCP1)ATEMP2=PRED(I)
              IF(ICOLRP.EQ.MAXCP2)ATEMP2=RES(I)
              IF(ICOLRP.EQ.MAXCP3)ATEMP2=YPLOT(I)
              IF(ICOLRP.EQ.MAXCP4)ATEMP2=XPLOT(I)
              IF(ICOLRP.EQ.MAXCP5)ATEMP2=X2PLOT(I)
              IF(ICOLRP.EQ.MAXCP6)ATEMP2=TAGPLO(I)
            ENDIF
C
            ICNT=ICNT+1
            IF(ICNT.GT.MAXOBV)THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,91417)
91417         FORMAT('****** WARNING FROM STACK COMMAND--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,91419)
91419         FORMAT('       MAXIMUM NUMBER OF ROWS, ',I8,
     1               ' HAS BEEN EXCEEDED.')
              CALL DPWRST('XXX','BUG ')
              GOTO91418
            ENDIF
C
            TEMP1(ICNT)=ATEMP
            TEMP2(ICNT)=REAL(IVARCN)
            TEMP91(ICNT)=ATEMP2
91413     CONTINUE
C
          J=0
          DO91415I=1,NITEMP
            IF(ISUB(I).EQ.0)GOTO91415
            J=J+1
91415     CONTINUE
91412   CONTINUE
91418   CONTINUE
C
        NITEMX=ICNT
        IFOUND='YES'
        GOTO11900
C
91499   CONTINUE
        IERROR='YES'
        GOTO9000
C
      ELSEIF(ICASL7.EQ.'FREQ')THEN
        CALL FREQUE(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
     1              TEMP91,NITEMX,IBUGA3,IERROR)
        DO11425I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11425   CONTINUE
      ELSEIF(ICASL7.EQ.'SUMD')THEN
CCCCC   JAN 1987--NOT DONE
CCCCC   CALL SUMD(TEMP1,NS1,TEMP2,NS2,NUMVAR,IWRITE,
CCCCC1            TEMP91,NITEMX,IBUGA3,IERROR)
CCCCC   DO11455I=1,NITEMX
CCCCC     TEMP1(I)=TEMP91(I)
11455   CONTINUE
      ELSEIF(ICASL7.EQ.'INTR')THEN
        NS3=0
        DO11461I=1,NIRIGH(3)
          NS3=NS3+1
          IJ=MAXN*(ICOLR(3)-1)+I
          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
11461   CONTINUE
        CALL INTERP(TEMP1,TEMP2,NS1,TEMP3,NS3,IWRITE,TEMP91,
     1              IBUGA3,ISUBRO,IERROR)
        NITEMX=NS3
        DO11465I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11465   CONTINUE
      ELSEIF(ICASL7.EQ.'LINT')THEN
        NS3=0
        DO11561I=1,NIRIGH(3)
          NS3=NS3+1
          IJ=MAXN*(ICOLR(3)-1)+I
          IF(ICOLR(3).LE.MAXCOL)TEMP3(NS3)=V(IJ)
          IF(ICOLR(3).EQ.MAXCP1)TEMP3(NS3)=PRED(I)
          IF(ICOLR(3).EQ.MAXCP2)TEMP3(NS3)=RES(I)
          IF(ICOLR(3).EQ.MAXCP3)TEMP3(NS3)=YPLOT(I)
          IF(ICOLR(3).EQ.MAXCP4)TEMP3(NS3)=XPLOT(I)
          IF(ICOLR(3).EQ.MAXCP5)TEMP3(NS3)=X2PLOT(I)
          IF(ICOLR(3).EQ.MAXCP6)TEMP3(NS3)=TAGPLO(I)
11561   CONTINUE
        CALL LININT(TEMP1,TEMP2,NS1,TEMP3,NS3,IWRITE,TEMP91,
     1              IBUGA3,ISUBRO,IERROR)
        NITEMX=NS3
        DO11565I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11565   CONTINUE
      ELSEIF(ICASL7.EQ.'2DIN')THEN
        NS4=0
        DO11571I=1,NIRIGH(4)
          NS4=NS4+1
          IJ=MAXN*(ICOLR(4)-1)+I
          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
11571   CONTINUE
        NS5=0
        DO11572I=1,NIRIGH(5)
          NS5=NS5+1
          IJ=MAXN*(ICOLR(5)-1)+I
          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
11572   CONTINUE
        NS6=0
        CALL INT2D(TEMP1,TEMP2,TEMP3,NS1,TEMP4,NS4,TEMP5,NS5,IWRITE,
     1             TEMP91,NS6,
     1             IBUGA3,ISUBRO,IERROR)
        NITEMX=NS6
        DO11575I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11575   CONTINUE
      ELSEIF(ICASL7.EQ.'BILI')THEN
        NS4=0
        DO11581I=1,NIRIGH(4)
          NS4=NS4+1
          IJ=MAXN*(ICOLR(4)-1)+I
          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
11581   CONTINUE
        NS5=0
        DO11582I=1,NIRIGH(5)
          NS5=NS5+1
          IJ=MAXN*(ICOLR(5)-1)+I
          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
11582   CONTINUE
        CALL BILINR(TEMP1,TEMP2,TEMP3,NS1,TEMP4,TEMP5,NS4,
     1              IWRITE,TEMP91,IBUGA3,ISUBRO,IERROR)
        NITEMX=NS4
        DO11585I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11585   CONTINUE
      ELSEIF(ICASL7.EQ.'BIVA')THEN
        NS4=0
        DO11591I=1,NIRIGH(4)
          NS4=NS4+1
          IJ=MAXN*(ICOLR(4)-1)+I
          IF(ICOLR(4).LE.MAXCOL)TEMP4(NS4)=V(IJ)
          IF(ICOLR(4).EQ.MAXCP1)TEMP4(NS4)=PRED(I)
          IF(ICOLR(4).EQ.MAXCP2)TEMP4(NS4)=RES(I)
          IF(ICOLR(4).EQ.MAXCP3)TEMP4(NS4)=YPLOT(I)
          IF(ICOLR(4).EQ.MAXCP4)TEMP4(NS4)=XPLOT(I)
          IF(ICOLR(4).EQ.MAXCP5)TEMP4(NS4)=X2PLOT(I)
          IF(ICOLR(4).EQ.MAXCP6)TEMP4(NS4)=TAGPLO(I)
11591   CONTINUE
        NS5=0
        DO11592I=1,NIRIGH(5)
          NS5=NS5+1
          IJ=MAXN*(ICOLR(5)-1)+I
          IF(ICOLR(5).LE.MAXCOL)TEMP5(NS5)=V(IJ)
          IF(ICOLR(5).EQ.MAXCP1)TEMP5(NS5)=PRED(I)
          IF(ICOLR(5).EQ.MAXCP2)TEMP5(NS5)=RES(I)
          IF(ICOLR(5).EQ.MAXCP3)TEMP5(NS5)=YPLOT(I)
          IF(ICOLR(5).EQ.MAXCP4)TEMP5(NS5)=XPLOT(I)
          IF(ICOLR(5).EQ.MAXCP5)TEMP5(NS5)=X2PLOT(I)
          IF(ICOLR(5).EQ.MAXCP6)TEMP5(NS5)=TAGPLO(I)
11592   CONTINUE
CCCCC   CALL BIVAR(TEMP1,TEMP2,TEMP3,NS1,TEMP4,TEMP5,NS4,
        CALL BIVAR(TEMP1,TEMP3,TEMP2,NS1,TEMP4,TEMP5,NS4,
     1             IWRITE,TEMP91,IBUGA3,ISUBRO,IERROR)
        NITEMX=NS4
        DO11595I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11595   CONTINUE
      ELSEIF(ICASL7.EQ.'BIWE')THEN
        CALL BIWEIG(TEMP1,NS1,IWRITE,TEMP91,IBUGA3,IERROR)
        DO11475I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11475   CONTINUE
      ELSEIF(ICASL7.EQ.'TRIC')THEN
        CALL TRICUB(TEMP1,NS1,IWRITE,TEMP91,IBUGA3,IERROR)
        DO11485I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11485   CONTINUE
      ELSEIF(ICASL7.EQ.'COCD')THEN
        CALL COCODE(TEMP1,NS1,TEMP2,NS2,TEMP91,IBUGA3)
        DO11495I=1,NS1
          TEMP1(I)=TEMP91(I)
11495   CONTINUE
      ELSEIF(ICASL7.EQ.'COCP')THEN
        CALL COCOPY(TEMP3,NS3,TEMP1,NS1,TEMP2,TEMP91,NITEMX,IBUGA3)
        DO11505I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11505   CONTINUE
      ELSEIF(ICASL7.EQ.'CODH')THEN
        NUMINT=4
        CALL CODEH(TEMP1,NS1,NUMINT,IWRITE,TEMP2,IBUGA3,IERROR)
        DO11645I=1,NS1
          TEMP1(I)=TEMP2(I)
11645   CONTINUE
      ELSEIF(ICASL7.EQ.'COD1'.OR.ICASL7.EQ.'COD2'.OR.
     1       ICASL7.EQ.'COD3'.OR.ICASL7.EQ.'COD4'.OR.
     1       ICASL7.EQ.'COD5'.OR.ICASL7.EQ.'COD6'.OR.
     1       ICASL7.EQ.'COD7'.OR.ICASL7.EQ.'COD8'.OR.
     1       ICASL7.EQ.'COD9'.OR.ICASL7.EQ.'CO10')THEN
        NUMINT=4
        IF(ICASL7.EQ.'COD1')NUMINT=1
        IF(ICASL7.EQ.'COD2')NUMINT=2
        IF(ICASL7.EQ.'COD3')NUMINT=3
        IF(ICASL7.EQ.'COD4')NUMINT=4
        IF(ICASL7.EQ.'COD5')NUMINT=5
        IF(ICASL7.EQ.'COD6')NUMINT=6
        IF(ICASL7.EQ.'COD7')NUMINT=7
        IF(ICASL7.EQ.'COD8')NUMINT=8
        IF(ICASL7.EQ.'COD9')NUMINT=9
        IF(ICASL7.EQ.'CO10')NUMINT=10
        CALL CODEN(TEMP1,NS1,NUMINT,IWRITE,TEMP2,IBUGA3,IERROR)
        DO11655I=1,NS1
          TEMP1(I)=TEMP2(I)
11655   CONTINUE
      ELSEIF(ICASL7.EQ.'SINT')THEN
        CALL SINTRA(TEMP1,NS1,IWRITE,TEMP2,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11715I=1,NITEMX
          TEMP1(I)=TEMP2(I)
11715   CONTINUE
      ELSEIF(ICASL7.EQ.'COST')THEN
        CALL COSTRA(TEMP1,NS1,IWRITE,TEMP2,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11725I=1,NITEMX
          TEMP1(I)=TEMP2(I)
11725   CONTINUE
      ELSEIF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
     1       ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1')THEN
        IF(ICASL7.EQ.'FOU1'.OR.ICASL7.EQ.'IFO1')THEN
          DO11732I=1,NS1
            TEMP2(I)=0.0
11732     CONTINUE
        ENDIF
        ITCASE=ICASL7
        CALL FOUTRA(TEMP1,TEMP2,TEMPC1,TEMP6,
     1              NS1,ITCASE,IWRITE,TEMP12,IFTEXP,IFTORD,
     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11735I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11735   CONTINUE
      ELSEIF(ICASL7.EQ.'FFT'.OR.ICASL7.EQ.'FFT1'.OR.
     1       ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1')THEN
        IF(ICASL7.EQ.'FFT1'.OR.ICASL7.EQ.'IFF1')THEN
          DO11742I=1,NS1
            TEMP2(I)=0.0
11742     CONTINUE
        ENDIF
        NS1NEW=NS1
        ITCASE=ICASL7
        CALL FOUTRA(TEMP1,TEMP2,TEMPC1,TEMP6,
     1              NS1NEW,ITCASE,IWRITE,TEMP12,IFTEXP,IFTORD,
     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
         IF(IERROR.EQ.'YES')GOTO19000
         DO11756I=1,NITEMX
           TEMP1(I)=TEMP91(I)
           TEMP2(I)=TEMP92(I)
11756   CONTINUE
      ELSEIF(ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR')THEN
        IRELAT='OFF'
        IF(ICASL7.EQ.'BINR')IRELAT='ON'
        CLWID=CLWIDT(1)
        XSTART=CLLIMI(1)
        XSTOP=CLLIMI(2)
        CALL DPBIN(TEMP1,NS1,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1             TEMP2,MAXOBV,IHSTCW,
     1             TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11791I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11791   CONTINUE
      ELSEIF(ICASL7.EQ.'ASHR'.OR.ICASL7.EQ.'ASHC')THEN
        IRELAT='ON'
        IF(ICASL7.EQ.'ASHC')IRELAT='OFF'
        CLWID=CLWIDT(1)
        XSTART=CLLIMI(1)
        XSTOP=CLLIMI(2)
C
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          M=8
        ELSE
          M=INT(VALUE(ILOCP)+0.5)
          IF(M.LE.0)M=1
          IF(M.GT.64)M=64
        ENDIF
C
        CALL DPBINA(TEMP1,NS1,CLWID,XSTART,XSTOP,M,
     1              TEMP1,MAXOBV,
     1              IRELAT,IASHWT,IHSTCW,
     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11796I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11796   CONTINUE
      ELSEIF(ICASL7.EQ.'LAPT')THEN
CCCCC   ITCASE='LT'
CCCCC   CALL LAPTRA(TEMP1,NS1,ITCASE,IWRITE,TEMP2,NITEMX,
CCCCC1              IBUGA3,IERROR)
CCCCC   IF(IERROR.EQ.'YES')GOTO19000
CCCCC   DO11815I=1,NITEMX
CCCCC     TEMP1(I)=TEMP2(I)
11815   CONTINUE
      ELSEIF(ICASL7.EQ.'ILAT')THEN
CCCCC   ITCASE='ILT'
CCCCC   CALL LAPTRA(TEMP1,NS1,ITCASE,IWRITE,TEMP2,NITEMX,
CCCCC               IBUGA3,IERROR)
CCCCC   IF(IERROR.EQ.'YES')GOTO19000
CCCCC   DO11825I=1,NITEMX
CCCCC     TEMP1(I)=TEMP2(I)
11825   CONTINUE
      ELSEIF(ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
     1       ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
     1       ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
     1       ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
     1       ICASL7.EQ.'COCO')THEN
        IF(ICASL7.EQ.'COR1')THEN
          DO11832I=1,NS1
            TEMP2(I)=0.0
11832     CONTINUE
        ENDIF
        IACASE=ICASL7
        CALL COMARI(TEMP1,TEMP2,TEMP3,TEMP4,NS1,IACASE,IWRITE,
     1              TEMP91,TEMP92,NITEMX,SCAL91,ITYP91,
     1              IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11839
        DO11835I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11835   CONTINUE
        NITEMX=NINEW
        IF(ICASL7.EQ.'CORO')NITEMX=NITEMX-1
        IF(ICASL7.EQ.'COR1')NITEMX=NITEMX-1
11839   CONTINUE
      ELSEIF(ICASL7.EQ.'POAD'.OR.ICASL7.EQ.'POSU'.OR.
     1       ICASL7.EQ.'POMU'.OR.ICASL7.EQ.'PODI'.OR.
     1       ICASL7.EQ.'POSQ'.OR.ICASL7.EQ.'POSR'.OR.
     1       ICASL7.EQ.'POGC'.OR.ICASL7.EQ.'POLC'.OR.
     1       ICASL7.EQ.'POEV')THEN
        IACASE=ICASL7
        CALL POLARI(TEMP1,TEMP2,TEMP2,TEMP2,NS1,NS2,IACASE,IWRITE,
     1              TEMP91,TEMP92,NITEMX,NITE2X,SCAL91,ITYP91,
     1              DTEMP1,DTEMP2,DTEMP3,
     1              IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11849
        DO11845I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11845   CONTINUE
        IF(ICASL7.EQ.'PODI')THEN
          DO11846I=1,NITE2X
            TEMP2(I)=TEMP92(I)
11846     CONTINUE
        ENDIF
11849   CONTINUE
      ELSEIF(ICASL7.EQ.'VEAD'.OR.ICASL7.EQ.'VESU'.OR.
     1       ICASL7.EQ.'VEDP'.OR.ICASL7.EQ.'VECP'.OR.
     1       ICASL7.EQ.'VELE'.OR.ICASL7.EQ.'VEDI'.OR.
     1       ICASL7.EQ.'VEAN')THEN
        IACASE=ICASL7
        CALL VECARI(TEMP1,TEMP2,NS1,IACASE,IWRITE,
     1              TEMP91,NITEMX,SCAL91,ITYP91,IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11859
        DO11855I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11855   CONTINUE
11859   CONTINUE
      ELSEIF(ICASL7.EQ.'SEUN'.OR.ICASL7.EQ.'SEIN'.OR.
     1       ICASL7.EQ.'SECO'.OR.ICASL7.EQ.'SECA'.OR.
     1       ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'SEEL')THEN
        IACASE=ICASL7
        CALL SETARI(TEMP1,TEMP2,NS1,NS2,IACASE,IWRITE,
     1              TEMP91,TEMP92,NITEMX,SCAL91,ITYP91,
     1              IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11869
        DO11865I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11865   CONTINUE
11869   CONTINUE
      ELSEIF(ICASL7.EQ.'LOAN'.OR.ICASL7.EQ.'LOOR'.OR.
     1       ICASL7.EQ.'LONA'.OR.ICASL7.EQ.'LONO'.OR.
     1       ICASL7.EQ.'LOIM'.OR.ICASL7.EQ.'LOEQ'.OR.
     1       ICASL7.EQ.'LONT'.OR.ICASL7.EQ.'LOXO')THEN
        IACASE=ICASL7
        CALL LOGARI(TEMP1,TEMP2,NS1,IACASE,IWRITE,
     1              TEMP91,NITEMX,SCAL91,ITYP91,IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11879
        DO11875I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11875   CONTINUE
11879   CONTINUE
      ELSEIF(ICASL7.EQ.'FRAC')THEN
        IPROD=4*NS1
        IF(IPROD.GT.MAXOBV)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11511)
11511     FORMAT('***** ERROR 11511 IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11512)
11512     FORMAT('      THE NEW FRACTAL VARIABLES WOULD BE ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11513)
11513     FORMAT('      TOO LONG (THAT IS, WOULD EXCEED ',I8,')')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        CALL FRACTA(TEMP1,TEMP2,NS1,IWRITE,
     1              TEMP91,TEMP92,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO11516I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
11516   CONTINUE
      ELSEIF(ICASL7.EQ.'BOOT')THEN
        CALL BOOTSS(TEMP1,TEMP2,NS1,IWRITE,
     1              TEMP91,NITEMX,IBUGA3,ISUBRO,IERROR)
        DO11525I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11525   CONTINUE
      ELSEIF(ICASL7.EQ.'SUBS')THEN
        CALL SUBSAM(TEMP1,TEMP2,NS1,NS2,IWRITE,
     1              TEMP91,NITEMX,IBUGA3,ISUBRO,IERROR)
        DO11535I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11535   CONTINUE
      ELSEIF(ICASL7.EQ.'GEMU')THEN
        IACASE=ICASL7
        CALL GENARI(TEMP1,TEMP2,TEMP2,TEMP2,NS1,NS2,IACASE,IWRITE,
     1              TEMP91,TEMP92,NITEMX,NITE2X,SCAL91,ITYP91,
     1              IBUGA3,ISUBRO,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        IF(ITYP91.EQ.'SCAL')GOTO11899
        DO11895I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11895   CONTINUE
11899   CONTINUE
      GOTO11900
C
      ELSEIF(ICASL7.EQ.'JAIN')THEN
        CALL JACKIN(TEMPS(1),TEMPS(2),IWRITE,
     1              TEMP91,NITEMX,IBUGA3,ISUBRO,IERROR)
        DO11545I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11545   CONTINUE
      ELSEIF(ICASL7.EQ.'FRAW')THEN
        CALL DPRAW(TEMP1,TEMP2,NS1,IWRITE,MAXOBV,TEMP3,NITEMX,
     1             IBUGA3,IERROR)
        IF(IERROR.EQ.'NO')THEN
          DO11555I=1,NITEMX
            TEMP1(I)=TEMP3(I)
11555     CONTINUE
        ENDIF
      ELSEIF(ICASL7.EQ.'CUSA' .OR. ICASL7.EQ.'CU1A')THEN
        ICASE='TWOS'
        IF(ICASL7.EQ.'CU1A')ICASE='ONES'
        CALL CUSARL(TEMP1,NS1,IWRITE,TEMP2,ICASE,IBUGA3,IERROR)
        DO21019I=1,NS1
          TEMP1(I)=TEMP2(I)
21019   CONTINUE
      ELSEIF(ICASL7.EQ.'SRTB')THEN
        CALL SRTMEA(TEMP1,TEMP2,NS1,ICASS7,
     1              MAXOBV,
     1              TEMP12,TEMP4,TEMP5,TEMP6,TEMP92,
     1              TEMP6(2*MAXOBV+1),TEMP6(3*MAXOBV+1),
     1              TEMP91,TEMP3,NUMSE1,
     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1              ISUBRO,IBUGA3,IERROR)
        DO21031I=1,NS1
          TEMP1(I)=TEMP91(I)
21031   CONTINUE
        DO21033I=1,NUMSE1
          TEMP2(I)=TEMP3(I)
21033   CONTINUE
      ELSEIF(ICASL7.EQ.'STAN'.OR.ICASL7.EQ.'ZSCO'.OR.
     1       ICASL7.EQ.'USCO'.OR.ICASL7.EQ.'LSTA'.OR.
     1       ICASL7.EQ.'LSST'.OR.ICASL7.EQ.'CRTA'.OR.
     1       ICASL7(1:2).EQ.'CT')THEN
C
        ICASE='STAN'
        IF(ICASL7.EQ.'LSTA')ICASE='LOCA'
        IF(ICASL7.EQ.'LSST')ICASE='SCAL'
        IF(ICASL7.EQ.'ZSCO')ICASE='ZSCO'
        IF(ICASL7.EQ.'USCO')ICASE='USCO'
        IF(ICASL7(1:2).EQ.'CT')THEN
          ICASE='CRTA'
          ICASE2=ICASL7
        ENDIF
        IFLAGV=1
        IF(ICASS7.EQ.'COVA')IFLAGV=2
        IF(ICASS7.EQ.'CORR')IFLAGV=2
        IF(ICASS7.EQ.'COMO')IFLAGV=2
        IF(ICASS7.EQ.'RACV')IFLAGV=2
        IF(ICASS7.EQ.'RACR')IFLAGV=2
        IF(ICASS7.EQ.'RACM')IFLAGV=2
        IF(ICASS7.EQ.'WICV')IFLAGV=2
        IF(ICASS7.EQ.'WICR')IFLAGV=2
        IF(ICASS7.EQ.'BIMC')IFLAGV=2
        IF(ICASS7.EQ.'BICR')IFLAGV=2
        IF(ICASS7.EQ.'PBCR')IFLAGV=2
        IF(ICASS7.EQ.'WEME')IFLAGV=2
        IF(ICASS7.EQ.'WEVA')IFLAGV=2
        IF(ICASS7.EQ.'WESD')IFLAGV=2
        IF(ICASS7.EQ.'DMEA')IFLAGV=2
        IF(ICASS7.EQ.'DMDM')IFLAGV=2
        IF(ICASS7.EQ.'DMED')IFLAGV=2
        IF(ICASS7.EQ.'DTRM')IFLAGV=2
        IF(ICASS7.EQ.'DWNM')IFLAGV=2
        IF(ICASS7.EQ.'DGEO')IFLAGV=2
        IF(ICASS7.EQ.'DHAR')IFLAGV=2
        IF(ICASS7.EQ.'DHDL')IFLAGV=2
        IF(ICASS7.EQ.'DBIW')IFLAGV=2
        IF(ICASS7.EQ.'DSD ')IFLAGV=2
        IF(ICASS7.EQ.'DVAR')IFLAGV=2
        IF(ICASS7.EQ.'DAAD')IFLAGV=2
        IF(ICASS7.EQ.'DMAD')IFLAGV=2
        IF(ICASS7.EQ.'DIQR')IFLAGV=2
        IF(ICASS7.EQ.'DWSD')IFLAGV=2
        IF(ICASS7.EQ.'DWVA')IFLAGV=2
        IF(ICASS7.EQ.'DBIM')IFLAGV=2
        IF(ICASS7.EQ.'DBIS')IFLAGV=2
        IF(ICASS7.EQ.'DPBN')IFLAGV=2
        IF(ICASS7.EQ.'DGSD')IFLAGV=2
        IF(ICASS7.EQ.'DRAN')IFLAGV=2
        IF(ICASS7.EQ.'DMDR')IFLAGV=2
        IF(ICASS7.EQ.'DQUA')IFLAGV=2
        IF(ICASS7.EQ.'DSKE')IFLAGV=2
        IF(ICASS7.EQ.'DKUR')IFLAGV=2
        IF(ICASS7.EQ.'DRSD')IFLAGV=2
        IF(ICASS7.EQ.'DSDM')IFLAGV=2
        IF(ICASS7.EQ.'DRVA')IFLAGV=2
        IF(ICASS7.EQ.'DVAM')IFLAGV=2
        IF(ICASS7.EQ.'DMIN')IFLAGV=2
        IF(ICASS7.EQ.'DMAX')IFLAGV=2
        IF(ICASS7.EQ.'DEXT')IFLAGV=2
        IF(ICASS7.EQ.'DCVA')IFLAGV=2
        IF(ICASS7.EQ.'DCOU')IFLAGV=2
        IF(ICASS7.EQ.'DSUM')IFLAGV=2
        IF(ICASS7.EQ.'RATI')IFLAGV=2
C
        IF(IFLAGV.EQ.1)THEN 
          CALL GRPSTA(TEMP1,TEMP2,TEMP3,NS1,NUMVAR,
     1                ICASE,ICASE2,ICASS7,
     1                MAXOBV,
     1                TEMP12,TEMP4,TEMP5,TEMP6,TEMP92,
     1                TEMP6(2*MAXOBV+1),TEMP6(3*MAXOBV+1),
     1                TEMP91,
     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1                ISUBRO,IBUGA3,IERROR)
        ELSE
          CALL GRPST2(TEMP1,TEMP2,TEMP3,TEMP4,NS1,NUMVAR,
     1                ICASE,ICASE2,ICASS7,
     1                MAXOBV,
     1                TEMP12,TEMP5,TEMP6,TEMP6(MAXOBV+1),
     1                TEMP6(2*MAXOBV+1),TEMP92,
     1                TEMP6(3*MAXOBV+1),
     1                TEMP91,
     1                ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1                ISUBRO,IBUGA3,IERROR)
        ENDIF
        DO21029I=1,NS1
          TEMP1(I)=TEMP91(I)
21029   CONTINUE
      ELSEIF(ICASL7.EQ.'WINS')THEN
C
        IH='P1  '
        IH2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        PROP1=VALUE(ILOCP)
C
        IH='P2  '
        IH2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IH,IH2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        PROP2=VALUE(ILOCP)
C
        IF(PROP1.LT.0.0 .OR. PROP1.GT.100.0 .OR.
     1     PROP2.LT.0.0 .OR. PROP2.GT.100.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21061)
21061     FORMAT('***** ERROR IN DPMATC--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21062)
21062     FORMAT('THE PROPORTION TO BE WINSORIZED BELOW AND ABOVE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21063)
21063     FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21064)PROP1
21064     FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21065)PROP2
21065     FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21066)
21066     FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21067)
21067     FORMAT('      LET P1 = 25')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,21068)
21068     FORMAT('      LET P2 = 10')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        CALL WINSOR(TEMP1,NS1,PROP1,PROP2,IWRITE,TEMP2,MAXOBV,TEMP3,
     1              IBUGA3,IERROR)
C
        DO21059I=1,NS1
          TEMP1(I)=TEMP3(I)
21059   CONTINUE
      ELSEIF(ICASL7.EQ.'CFRT')THEN
        IHP='MINS'
        IHP2='IZE '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          MINSIZ=5
        ELSE
          MINSIZ=INT(VALUE(ILOCP)+0.5)
          IF(MINSIZ.LE.0)MINSIZ=5
        ENDIF
C
        CALL DPCOMB(TEMP1,TEMP2,NS1,MINSIZ,
     1              TEMP91,TEMP92,TEMP5,NITEMX,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO22016I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
          TEMP91(I)=TEMP5(I)
22016   CONTINUE
      ELSEIF(ICASL7.EQ.'IFRT')THEN
        IHP='MINS'
        IHP2='IZE '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          MINSIZ=5
        ELSE
          MINSIZ=INT(VALUE(ILOCP)+0.5)
          IF(MINSIZ.LE.0)MINSIZ=5
        ENDIF
C
        CALL DPICOM(TEMP1,TEMP2,NS1,MINSIZ,
     1              TEMP91,TEMP92,TEMP5,NITEMX,
     1              ISUBRO,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
        DO22116I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
          TEMP91(I)=TEMP5(I)
22116   CONTINUE
      ELSEIF(ICASL7.EQ.'HCON')THEN
        CALL HCONS(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,NS1,IWRITE,
     1             TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
        DO22029I=1,NITEMX
          TEMP1(I)=TEMP91(I)
22029   CONTINUE
      ELSEIF(ICASL7.EQ.'KCON')THEN
        CALL KCONS(TEMP1,TEMP2,TEMP3,TEMP4,NS1,IWRITE,
     1             TEMP91,NITEMX,ISUBRO,IBUGA3,IERROR)
        DO22039I=1,NITEMX
          TEMP1(I)=TEMP91(I)
22039   CONTINUE
      ELSEIF(ICASL7.EQ.'HCO2')THEN
        CALL HCONS2(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP12,
     1              NS1,IWRITE,
     1              TEMP91,TEMP92,NITEMX,ISUBRO,IBUGA3,IERROR)
        DO22049I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
22049   CONTINUE
      ELSEIF(ICASL7.EQ.'KCO2')THEN
        CALL KCONS2(TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
     1              NS1,IWRITE,
     1              TEMP91,TEMP92,NITEMX,ISUBRO,IBUGA3,IERROR)
        DO22059I=1,NITEMX
          TEMP1(I)=TEMP91(I)
          TEMP2(I)=TEMP92(I)
22059   CONTINUE
      ELSEIF(ICASL7.EQ.'LMOM')THEN
        NMOM=INT(TEMPS(2)+0.5)
        IF(NMOM.LE.0)NMOM=4
        IF(NMOM.GT.100)NMOM=100
        IF(NMOM.GE.NS1)NMOM=NS1
        DO22061I=1,NS1
          DTEMP1(I)=DBLE(TEMP1(I))
22061   CONTINUE
        CALL SAMLMU(DTEMP1,NS1,DTEMP2,NMOM)
        DO22063I=1,NMOM
          TEMP1(I)=REAL(DTEMP2(I))
22063   CONTINUE
        NITEMX=NMOM
      ELSEIF(ICASL7.EQ.'PWMO')THEN
        NMOM=INT(TEMPS(2)+0.5)
        IF(NMOM.LE.0)NMOM=4
        IF(NMOM.GT.20)NMOM=20
        IF(NMOM.GE.NS1)NMOM=NS1
        ATEMP=0.0D0
        BTEMP=0.0D0
        IKIND=1
        DO22071I=1,NS1
          DTEMP1(I)=DBLE(TEMP1(I))
22071   CONTINUE
        CALL SAMPWM(DTEMP1,NS1,DTEMP2,NMOM,ATEMP,BTEMP,IKIND)
        DO22073I=1,NMOM
          TEMP1(I)=REAL(DTEMP2(I))
22073   CONTINUE
        NITEMX=NMOM
      ELSEIF(ICASL7.EQ.'BPWM')THEN
        NMOM=INT(TEMPS(2)+0.5)
        IF(NMOM.LE.0)NMOM=4
        IF(NMOM.GT.20)NMOM=20
        IF(NMOM.GE.NS1)NMOM=NS1
        ATEMP=0.0D0
        BTEMP=0.0D0
        IKIND=2
        DO22081I=1,NS1
          DTEMP1(I)=DBLE(TEMP1(I))
22081   CONTINUE
        CALL SAMPWM(DTEMP1,NS1,DTEMP2,NMOM,ATEMP,BTEMP,IKIND)
        DO22083I=1,NMOM
          TEMP1(I)=REAL(DTEMP2(I))
22083   CONTINUE
        NITEMX=NMOM
      ELSE
        WRITE(ICOUT,11301)
11301   FORMAT('***** INTERNAL ERROR 11301 IN DPMATC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11302)
11302   FORMAT('      NAME OF DESIRED DATA MANIPULATION OPERATION')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11303)
11303   FORMAT('      WAS FOUND IN INTERNAL LIST IN CKMATH, BUT JUMP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11305)
11305   FORMAT('      TO APPROPRIATE SUBROUTINE DID NOT TAKE PLACE ',
     1         'IN DPMATC.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11306)ICASL7
11306   FORMAT('ICASL7 = ',A4)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
      ENDIF
      GOTO11900
C
C     -----BEGINNING OF MATH CALCULATIONS-----
C
11900 CONTINUE
      IFOUND='YES'
      IF(IERROR.EQ.'YES')GOTO19000
C
C
C               *****************************************************
C               **  STEP XX--                                      **
C               **  BRANCH TO THE PROPER CASE
C               **  DEPENDING ON THE TYPE OF OUTPUT--
C               **     1) SCALAR (= PARAMETER)
C               **     2) VECTOR (= VARIABLE) (THE USUAL)
C               **     3) MATRIX
C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE
C               **  AND HOUSEKEEPING TABLES
C               *****************************************************
C
12000 CONTINUE
C
C               *****************************************************
C               **  STEP 14--                                      **
C               **  TREAT THE PARAMETER (SCALAR) CASE.             **
C               **  EXAMPLE--LET D = DETERMINANT A                 **
C               **           WHERE A WAS PREVIOUSLY UNDEFINED      **
C               **           OR WHERE A WAS PREVIOUSLY A PARAMETER.**
C               **  CARRY OUT THE LIST UPDATING  AND               **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
      IF(ITYP91.EQ.'SCAL')THEN
        ISTEPN='14'
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MATC')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        IHNAME(ILISL(1))=ILEFT(1)
        IHNAM2(ILISL(1))=ILEFT(2)
        IUSE(ILISL(1))='P'
        VALUE(ILISL(1))=SCAL91
        IVALUE(ILISL(1))=VALUE(ILISL(1))+0.5
        IN(ILISL(1))=1
        IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
C
        IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,14011)ILEFT(1),ILEFT(2),SCAL91
14011     FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
     1           A4,A4,'      = ',E15.8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        GOTO19000
      ENDIF
C
C     -----TREAT THE VECTOR AND MATRIX CASE-----
C
C
C
12100 CONTINUE
      ISTEPN='11.1'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STORE FIRST VARIABLE ON THE LEFT
C
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)THEN
        IN(ILISL(1))=0
        GOTO12119
      ENDIF
C
      IF(IUPFLG.EQ.'FULL' .OR. ICASEQ.EQ.'FULL')THEN
        DO12105I=1,NITEMX
          ISUB(I)=1
12105   CONTINUE
        NIFOR=NITEMX
      ENDIF
C
      DO12110I=1,NITEMX
C
        IF(I.GT.NIFOR)GOTO12110
        IF(ISUB(I).EQ.0)GOTO12110
        NSX=NSX+1
C
        IJ=MAXN*(ICOLL(1)-1)+I
        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
C
        IF(NSX.EQ.1)IROW1=I
        IROWN=I
C
12110 CONTINUE
C
      IN(ILISL(1))=NITEMX
C
12119 CONTINUE
C
C     STORE SECOND VARIABLE ON THE LEFT
C
      IF(ICASL7.EQ.'FOUT'.OR.ICASL7.EQ.'FOU1'.OR.
     1   ICASL7.EQ.'IFOU'.OR.ICASL7.EQ.'IFO1'.OR.
     1   ICASL7.EQ.'FFT' .OR.ICASL7.EQ.'FFT1'.OR.
     1   ICASL7.EQ.'IFFT'.OR.ICASL7.EQ.'IFF1'.OR.
     1   ICASL7.EQ.'COAD'.OR.ICASL7.EQ.'COSU'.OR.
     1   ICASL7.EQ.'COMU'.OR.ICASL7.EQ.'CODI'.OR.
     1   ICASL7.EQ.'COEX'.OR.ICASL7.EQ.'COSR'.OR.
     1   ICASL7.EQ.'CORO'.OR.ICASL7.EQ.'COR1'.OR.
     1   ICASL7.EQ.'COCO'.OR.ICASL7.EQ.'PODI'.OR.
     1   ICASL7.EQ.'SECP'.OR.ICASL7.EQ.'FRAC'.OR.
     1   ICASL7.EQ.'BINN'.OR.ICASL7.EQ.'BINR'.OR.
     1   ICASL7.EQ.'ASHC'.OR.ICASL7.EQ.'ASHR'.OR.
     1   ICASL7.EQ.'STAC'.OR.ICASL7.EQ.'RSTA'.OR.
     1   ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'HCO2'.OR.
     1   ICASL7.EQ.'IFRT'.OR.
     1   ICASL7.EQ.'KCO2'.OR.ICASL7.EQ.'SRTB')THEN
C
        NSX=0
        NITEM2=NITEMX
        IF(ICASL7.EQ.'SRTB')NITEM2=NUMSE1
        IF(ICASL7.EQ.'PODI')NITEM2=NITE2X
        IF(NITEM2.LE.0)IROW12=0
        IF(NITEM2.LE.0)IROWN2=0
        IF(NITEM2.LE.0)THEN
          IN(ILISL(2))=0
          GOTO12129
        ENDIF
C
        DO12120I=1,NITEM2
C
          IF(NITEM2.EQ.NITEMX)THEN
            IF(I.GT.NIFOR)GOTO12120
            IF(ISUB(I).EQ.0)GOTO12120
          ENDIF
          NSX=NSX+1
C
          IJ=MAXN*(ICOLL(2)-1)+I
          IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP2(NSX)
C
          IF(NSX.EQ.1)IROW12=I
          IROWN2=I
C
12120   CONTINUE
C
        IN(ILISL(2))=NITEM2
C
12129   CONTINUE
      ENDIF
C
      IF(ICASL7.EQ.'CFRT'.OR.ICASL7.EQ.'RSTA'.OR.
     1   ICASL7.EQ.'IFRT')THEN
C
        NSX=0
        NITEM3=NITEMX
        IF(NITEM3.LE.0)IROW13=0
        IF(NITEM3.LE.0)IROWN3=0
        IF(NITEM3.LE.0)THEN
          IN(ILISL(3))=0
          GOTO12139
        ENDIF
C
        DO12130I=1,NITEM3
C
          IF(NITEM3.EQ.NITEMX)THEN
            IF(I.GT.NIFOR)GOTO12130
            IF(ISUB(I).EQ.0)GOTO12130
          ENDIF
          NSX=NSX+1
C
          IJ=MAXN*(ICOLL(3)-1)+I
          IF(ICOLL(3).LE.MAXCOL)V(IJ)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP1)PRED(I)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP2)RES(I)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP3)YPLOT(I)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP4)XPLOT(I)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP5)X2PLOT(I)=TEMP91(NSX)
          IF(ICOLL(3).EQ.MAXCP6)TAGPLO(I)=TEMP91(NSX)
C
          IF(NSX.EQ.1)IROW13=I
          IROWN3=I
C
12130   CONTINUE
C
        IN(ILISL(3))=NITEM3
C
12139   CONTINUE
      ENDIF
C
12190 CONTINUE
C
      DO12210J4=1,NUMNAM
        IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1)).OR.
     1     (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1)))THEN
          IUSE(J4)='V'
          IVALUE(J4)=ICOLL(1)
          VALUE(J4)=ICOLL(1)
          IN(J4)=NITEMX
          IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')THEN
            IVALUE(J4)=ICOLL(1)
            IVALU2(J4)=ICOLL(1)+NC91-1
          ENDIF
        ENDIF
12210 CONTINUE
C
      IF(NUMVAL.GE.2)THEN
        DO12220J4=1,NUMNAM
          IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2)).OR.
     1       (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2)))THEN
            IUSE(J4)='V'
            IVALUE(J4)=ICOLL(2)
            VALUE(J4)=ICOLL(2)
            IN(J4)=NITEM2
          ENDIF
12220   CONTINUE
      ENDIF
C
      IF(NUMVAL.GE.3)THEN
        DO12230J4=1,NUMNAM
          IF((IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(3)).OR.
     1       (IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(3)))THEN
            IUSE(J4)='V'
            IVALUE(J4)=ICOLL(3)
            VALUE(J4)=ICOLL(3)
            IN(J4)=NITEM3
          ENDIF
12230   CONTINUE
      ENDIF
C
C               *******************************************
C               **  STEP 16--                            **
C               **  TREAT THE VARIABLE (VECTOR) CASE--   **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
16000 CONTINUE
      ISTEPN='16'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISL(1))=ILEFT(1)
      IHNAM2(ILISL(1))=ILEF2(1)
      IUSE(ILISL(1))='V'
      IVALUE(ILISL(1))=ICOLL(1)
      VALUE(ILISL(1))=ICOLL(1)
      IF(NEWNAM(1).EQ.'YES')THEN
        NUMNAM=NUMNAM+1
        NUMCOL=NUMCOL+1
      ENDIF
C
      IF(NUMVAL.GE.2)THEN
        IHNAME(ILISL(2))=ILEFT(2)
        IHNAM2(ILISL(2))=ILEF2(2)
        IUSE(ILISL(2))='V'
        IVALUE(ILISL(2))=ICOLL(2)
        VALUE(ILISL(2))=ICOLL(2)
        IF(NEWNAM(2).EQ.'YES')THEN
          NUMNAM=NUMNAM+1
          NUMCOL=NUMCOL+1
        ENDIF
      ENDIF
C
      IF(NUMVAL.GE.3)THEN
        IHNAME(ILISL(3))=ILEFT(3)
        IHNAM2(ILISL(3))=ILEF2(3)
        IUSE(ILISL(3))='V'
        IVALUE(ILISL(3))=ICOLL(3)
        VALUE(ILISL(3))=ICOLL(3)
        IF(NEWNAM(3).EQ.'YES')THEN
          NUMNAM=NUMNAM+1
          NUMCOL=NUMCOL+1
        ENDIF
      ENDIF
C
      IF(IPRINT.EQ.'ON' .AND. IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
        WRITE(ICOUT,16011)ILEFT(1),ILEF2(1),NSX
16011   FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1         'THE VARIABLE ',A4,A4,' = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IJ=MAXN*(ICOLL(1)-1)+IROW1
        IF(ICOLL(1).LE.MAXCOL)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),V(IJ),IROW1
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP1)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),PRED(IROW1),IROW1
16021     FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1           ' = ',E16.7,'   (ROW ',I6,')')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP2)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),RES(IROW1),IROW1
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP3)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),YPLOT(IROW1),IROW1
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP4)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),XPLOT(IROW1),IROW1
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP5)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),X2PLOT(IROW1),IROW1
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP6)THEN
          WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),TAGPLO(IROW1),IROW1
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IJ=MAXN*(ICOLL(1)-1)+IROWN
        IF(ICOLL(1).LE.MAXCOL.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(2),V(IJ),IROWN
16031     FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1           ' = ',E16.7,'   (ROW ',I6,')')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP1.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),PRED(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP2.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),RES(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP3.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),YPLOT(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP4.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),XPLOT(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP5.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),X2PLOT(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ELSEIF(ICOLL(1).EQ.MAXCP6.AND.NSX.NE.1)THEN
          WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),TAGPLO(IROWN),IROWN
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NSX.EQ.1)THEN
          WRITE(ICOUT,16032)
16032     FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,16033)
16033     FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(NUMVAL.GE.2)THEN
          WRITE(ICOUT,16011)ILEFT(2),ILEF2(2),NSX
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IJ=MAXN*(ICOLL(2)-1)+IROW1
          IF(ICOLL(2).LE.MAXCOL)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),V(IJ),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP1)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),PRED(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP2)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),RES(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP3)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),YPLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP4)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),XPLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP5)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),X2PLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP6)THEN
            WRITE(ICOUT,16021)ILEFT(2),ILEF2(2),TAGPLO(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IJ=MAXN*(ICOLL(2)-1)+IROWN
          IF(ICOLL(2).LE.MAXCOL.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),V(IJ),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP1.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),PRED(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP2.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),RES(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP3.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),YPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP4.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),XPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP5.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),X2PLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(2).EQ.MAXCP6.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(2),ILEF2(2),TAGPLO(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(NSX.EQ.1)THEN
            WRITE(ICOUT,16032)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,16033)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
        ENDIF
C
        IF(NUMVAL.GE.3)THEN
          WRITE(ICOUT,16011)ILEFT(3),ILEF2(3),NSX
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IJ=MAXN*(ICOLL(3)-1)+IROW1
          IF(ICOLL(3).LE.MAXCOL)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),V(IJ),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP1)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),PRED(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP2)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),RES(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP3)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),YPLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP4)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),XPLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP5)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),X2PLOT(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP6)THEN
            WRITE(ICOUT,16021)ILEFT(3),ILEF2(3),TAGPLO(IROW1),IROW1
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IJ=MAXN*(ICOLL(3)-1)+IROWN
          IF(ICOLL(3).LE.MAXCOL.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),V(IJ),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP1.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),PRED(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP2.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),RES(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP3.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),YPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP4.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),XPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP5.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),X2PLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ELSEIF(ICOLL(3).EQ.MAXCP6.AND.NSX.NE.1)THEN
            WRITE(ICOUT,16031)NSX,ILEFT(3),ILEF2(3),TAGPLO(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(NSX.EQ.1)THEN
            WRITE(ICOUT,16032)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,16033)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO19000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MATC')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19011)
19011   FORMAT('***** AT THE END       OF DPMATC--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19012)IFOUND,IERROR
19012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19013)IBUGA3,IBUGQ,ISUBRO
19013   FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19014)ICASL7,ILOCV,ITCASE,IWRITE
19014   FORMAT('ICASL7,ILOCV,ITCASE,IWRITE = ',A4,2X,I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19015)IFTEXP
19015   FORMAT('IFTEXP = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19016)NSX,NITEMX,NS1,NS2
19016   FORMAT('NSX,NITEMX,NS1,NS2 = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19021)ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1)
19021   FORMAT('ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1) = ',A4,2X,A4,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19022)ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2)
19022   FORMAT('ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2) = ',A4,2X,A4,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19023)NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR
19023   FORMAT('NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR = ',
     1         I8,2X,A4,2X,A4,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19024)ILISR(1),ILISR(2),ILISR(3),ILISR(4)
19024   FORMAT('ILISR(1),ILISR(2),ILISR(3),ILISR(4) = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19025)ICOLR(1),ICOLR(2),ICOLR(3),ICOLR(4)
19025   FORMAT('ICOLR(1),ICOLR(2),ICOLR(3),ICOLR(4) = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19026)TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4)
19026   FORMAT('TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4) = ',4E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19027)ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4)
19027   FORMAT('ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4) = ',
     1         A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19031)IMATSW,NUMVAR
19031   FORMAT('IMATSW,NUMVAR = ',A4,I8)
        CALL DPWRST('XXX','BUG ')
        IF(ITYPA(1).EQ.'VARI')THEN
          WRITE(ICOUT,19033)ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),
     1                      IVALU2(ILISR(1))
19033     FORMAT('ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),',
     1           'IVALU2(ILISR(1)) = ',
     1           4I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,19034)ILOCR(3),ILOCR(4),ILOCR(5),ILOCR(6),
     1                    ILOCR(7)
19034   FORMAT('ILOCR3,...,ILOCR7 = ',5I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMAT2(ICASL7,ICASS7,ILOCV,IFTEXP,IFTORD,
     1IMSUBC,
CCCCC MAY 2002.  ADD ISEED ARGUMENT
     1ISEED,
     1IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC OCTOBER 1998.  SPLIT INTO 2 FILES (LAHEY COMPILER
CCCCC SEEMS TO HAVE MEMORY TROUBLES WITH THE FULL ROUTINE).
CCCCC ESSENTIALLY, SPLIT OUT THE MATRIX AND NON-MATRIX COMMANDS.
CCCCC THIS ROUTINE, DPMAT2, IS THE MATRIX COMMANDS.
C
C     PURPOSE--TREAT THE TYPE 7 LET CASE--
C                      (FOR A FULL OR PARTIAL DATA SET)
C                 LET M3 = MATRIX ADDITION M1 M2 
C                 LET M3 = MATRIX ADDITION M1 P1
C                 LET M3 = MATRIX SUBTRACTION M1 M2 
C                 LET M3 = MATRIX SUBTRACTION M1 P1
C                 LET M3 = MATRIX MULTIPLICATION M1 M2
C                 LET M3 = MATRIX MULTIPLICATION M1 V1
C                 LET M3 = MATRIX MULTIPLICATION M1 P1
C                 LET M3 = MATRIX TRUNCATION M1 P1
C                 LET V3 = MATRIX SOLUTION M1 V2     
C                 LET V3 = MATRIX ITERATIVE SOLUTION M1 V2     
C                 LET M3 = MATRIX INVERSE M1        
C                 LET M3 = MATRIX TRANSPOSE M1     
C                 LET M3 = MATRIX ADJOINT M1      
C                 LET V3 = MATRIX CHAR EQUATION M1   (NOT YET IMP)
C                 LET V3 = MATRIX EIGENVALUES M1   
C                 LET M3 = MATRIX EIGENVECTORS M1 
C                 LET M3 = MATRIX RANK M1  
C                 LET P3 = MATRIX DETERMINANT M1
C                 LET P3 = MATRIX PERMANENT M1       (NOT YET IMP)
C                 LET P3 = MATRIX SPECTRAL NORM M1 
C                 LET P3 = MATRIX SPECTRAL RADIUS M1
C                 LET P3 = MATRIX NUMBER OF ROWS M1 
C                 LET P3 = MATRIX NUMBER OF COLUMNS M1 
C                 LET V4 = MATRIX SIMPLEX SOLUTION V1 M1 
C                 LET P3 = MATRIX TRACE M1
C                 LET M3 = MATRIX SUBMATRIX M1 P1 P2
C                 LET P3 = MATRIX MINOR M1 P1 P2
C                 LET P3 = MATRIX COFACTOR M1 P1 P2
C                 LET M3 = MATRIX DEFINITION M1 P1 P2 
C                 LET P3 = MATRIX EUCLIDEAN NORM M1
C                 LET P3 = MATRIX ROW M1 P1
C                 LET P3 = MATRIX ELEMENT M1 P2
C                 LET M3 = MATRIX REPACE ROW M1 V2 P3
C                 LET M3 = MATRIX ADD ROW M1 V1
C                 LET M3 = MATRIX DELETE ROW M1 S1
C                 LET M3 = MATRIX REPACE ELEMENT M1 V2 P3 P4
C                 LET M3 = MATRIX CHOLESKY DECOMPOSITION  M1 
C                 LET M3 = MATRIX AUGMENT  M1 M2
C                 LET V3 = MATRIX DIAGONAL  M1
C                 LET M3 = DIAGONAL MATRIX V1
C                 LET V3 = TRIDIAGONAL SOLUTION M1 V2
C                 LET V3 = TRIANGULAR SOLUTION M1 V2
C                 LET M3 = TRIANGULAR INVERSE M1
C
C                 LET A1 = MATRIX MEAN M1
C                 LET A1 = MATRIX SUM  M1
C                 LET M2 = MATRIX GROUP MEANS M1 TAG
C                 LET M2 = MATRIX GROUP STANDARD DEVIATIONS M1 TAG
C                 LET A1 = MATRIX ROW  M1
C                 LET A1 = MATRIX COLUMN  M1
C                 LET A1 = MATRIX PARTITION  M1 NROW NCOL
C                 LET A1 = MATRIX GRAND  M1
C                 LET V1 V2 = MATRIX BIN  M1
C                 LET M2 = MATRIX ROW SCALE M1
C                 LET M2 = MATRIX COLUMN SCALE M1
C                 LET A1 = QUADRATIC FORM M1 Y1
C                 LET A1 = HOTELLING 1-SAMPLE T-SQUARE M1 U1
C                 LET A1 = HOTELLING 2-SAMPLE T-SQUARE M1 M2
C                 LET M3 = POOLED VARIANCE-COVARIANCE MATRIX M1 M2
C                 LET M2 = PSUEDO INVERSE M1
C                 LET M2 M3 = QR DECOMPOSITION M1
C                 LET M2 = MATRIX EUCLIDEAN ROW DISTANCE M1
C                 LET M2 = MATRIX EUCLIDEAN COLUMN DISTANCE M1
C                 LET M2 = MATRIX MAHALONOBIS ROW DISTANCE M1
C                 LET M2 = MATRIX MAHALONOBIS COLUMN DISTANCE M1
C                 LET M2 = MATRIX BLOCK ROW DISTANCE M1
C                 LET M2 = MATRIX BLOCK COLUMN DISTANCE M1
C                 LET M2 = MATRIX MINKOWSKY ROW DISTANCE M1
C                 LET M2 = MATRIX MINKOWSKY COLUMN DISTANCE M1
C                 LET M2 = MATRIX CHEBYCHEV ROW DISTANCE M1
C                 LET M2 = MATRIX CHEBYCHEV COLUMN DISTANCE M1
C                 LET Y1 = DISTANCE FROM MEAN M1
C                 LET Y2 = LINEAR COMBINATION M Y1
C                 LET M1 = VECTOR TIMES TRANSPOSE Y1
C                 LET M3 = VARIANCE-COVARIANCE MATRIX M1
C                 LET M3 = CORRELATION MATRIX M1
C                 LET M3 = PRINCIPLE COMPONENTS M1
C                 LET V3 = ... PRINCIPLE COMPONENT M1
C                 LET M4 V3 M3 = SINGULAR VALUE M1
C                 LET M4 V3 M3 = SINGULAR VALUE DECOMPOSITION M1
C                 LET M4 V3 M3 = SINGULAR VALUE FACTORIZATION M1
C                 LET M2 = CATCHER MATRIX M1
C                 LET M2 = INDEPENDENT UNIFORM RAND NUMB LOWL UPPL P
C                 LET M2 = CORRELATED UNIFORM RAND NUMB SIGMA N
C                 LET M2 = MULTIVARIATE NORM RAND NUMB V1 M1 N
C                 LET M2 = MULTIVARIATE T RAND NUMB V1 M1 NU N
C                 LET M2 = MULTINOMIAL RAND NUMB V1 M1 N
C                 LET M2 = WISHART RAND NUMB V1 M1 N
C                 LET M2 = DIRICHLET RAND NUMB ALPHA N
C                 LET A2 = DIRICHLET PDF X ALPHA
C                 LET A2 = DIRICHLET LOG PDF X ALPHA
C                 LET M2 = MULTIVARIATE NORM CDF V1 M1 N
C                 LET M2 = MULTIVARIATE T CDF V1 M1 N
C                 LET A2 = MULTINOMIAL PDF X P
C                 LET M2 = XTXINV MATRIX M1
C                 LET Y1 = VARIANCE INFLATION FACTOR M1
C                 LET Y1 = CONDITION INDICES M1
C                 LET M1 = CREATE MATRIX V1 V2 ....VK
C
C     NOTE--THIS SUBROUTINE OPERATES ON A VECTOR
C           AND PRODUCES A VECTOR;
C           THIS IS TO BE CONTRASTED WITH DPLET8 WHICH
C           OPERATES ON A VECTOR
C           BUT PRODUCES A PARAMETER (= A SCALAR).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--MARCH 1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1987.
C     UPDATED         --APRIL     1987.
C     UPDATED         --AUGUST    1987.       COMPLEX SQUARE ROOT
C     UPDATED         --AUGUST    1987.       COMPLEX ROOTS (POLYNOMIAL)
C     UPDATED         --AUGUST    1987.       POLYNOMIAL ARITHMETIC
C     UPDATED         --AUGUST    1987.       VECTOR ARITHMETIC
C     UPDATED         --AUGUST    1987.       SET ARITHMETIC
C     UPDATED         --AUGUST    1987.       LOGICAL ARITHMETIC
C     UPDATED         --SEPTEMBER 1987.       FFT AND INVERSE FFT
C     UPDATED         --SEPTEMBER 1987.       MATRIX OPERATIONS
C     UPDATED         --SEPTEMBER 1987.       COMPLEX CONJUGATE
C     UPDATED         --NOVEMBER  1987.  (EXIT OUT IF ERROR)
C     UPDATED         --FEBRUARY  1988.  (BIWEIGHT AND TRICUBE)
C     UPDATED         --JULY      1988.  FRACTAL
C     UPDATED         --AUGUST    1988.  LENGTH TRAP FOR FRACTAL
C     UPDATED         --JANAURY   1988.  BOOTSTRAP SAMPLE
C     UPDATED         --AUGUST    1988.  (VARIANCE-COVARIANCE MATRIX)
C     UPDATED         --AUGUST    1988.  (CORRELATION MATRIX)
C     UPDATED         --AUGUST    1988.  (PRINCIPLE COMPONENTS)
C     UPDATED         --AUGUST    1988.  (... PRINCIPLE COMPONENTS)
C     UPDATED         --JANUARY   1989.  FIX A FORMAT STATEMENT (ALAN)
C     UPDATED         --NOVEMBER  1989.  FIX INTERPOLATION
C     UPDATED         --DECEMBER  1989.  (DEX) GENERATOR MULTIPLICATION
C     UPDATED         --JANUARY   1990.  SUBSAMPLE
C     UPDATED         --JULY      1991.  COCODE ('COCD')
C     UPDATED         --JULY      1991.  COCOPY ('COCP')
C     UPDATED         --FEBRUARY  1992.  FIX COCOPY ('COCP')
C     UPDATED         --MARCH     1992. EXT. SORT&CARRY TO MULTI ARGS
C     UPDATED         --MARCH     1992. ID IN ALL ERROR STATEMENTS
C     UPDATED         --APRIL     1992. SPLIT LONG FORMAT STATEMENTS
C     UPDATED         --MAY       1992. FIX IF .AND. IF
C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
C     UPDATED         --MAY       1992. FIX COMPLEX ARITH./SUBSET BUG
C                     --MAY       1992.(SHOULD FOR POLARI,LOGARI,..?)
C     UPDATED         --JULY      1993. UPDATES FOR MATRIX CODE
C     UPDATED         --AUGUST    1993. UPDATES FOR MATRIX CODE
C     UPDATED         --SEPTEMBER 1993. UPDATES FOR MATRIX CODE
C     UPDATED         --SEPTEMBER 1993. FIX BUG FOR COMPLEX ROOTS
C     UPDATED         --OCTOBER   1993. JACNIFE INDEX
C     UPDATED         --OCTOBER   1993. ADDITIONAL MATRIX COMMANDS
C     UPDATED         --MAY       1994. LINEAR INTERPOLATE, 2D INTERPOL
C                                       BILINEAR INTERPOLATE, BIVARIATE
C                                       INTERPOLATE
C     UPDATED         --JUNE      1995. BUG IN MATRIX REPLACE ELEMENT
C     UPDATED         --AUGUST    1995. ZERO PADDING NO LONGER REQUIRED
C                                       FOR FFT.
C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE FEWER
C                                       MATRICES (AND THUS CAN HANDLE
C                                       LARGER MATRICES).
C     UPDATED         --JANUARY   1998. RECODE MATRIX CODE TO USE
C                                       1-DIMENSIONAL SCRATCH ARRAYS
C                                       (WILL BE 2-D IN MATARI, MATAR2)
C     UPDATED         --MAY       1998. INTERARRIVAL TIMES CASE
C     UPDATED         --MAY       1998. CUMULATIVE AVERAGE CASE
C     UPDATED         --MAY       1998. REVERSE CASE
C     UPDATED         --MAY       1998. CUMULATIVE HAZARD CASE
C     UPDATED         --MAY       1998. HAZARD CASE
C     UPDATED         --SEPTEMBER 1998. EXPONENTIAL SMOOTHING
C     UPDATED         --JUNE      1998. SOME NEW MATRIX COMMANDS
C     UPDATED         --AUGUST    1998. MATRIX MEAN
C     UPDATED         --AUGUST    1998. MATRIX ADD ROW, MATRIX DELE ROW
C     UPDATED         --AUGUST    1998. DISTANCE FROM MEAN
C     UPDATED         --AUGUST    1998. FOR MATRIX COMMANDS, FIX HOW
C                                       SUBSETTING HANDLED WHEN OUTPUT
C                                       IS SAVED.  THE IUPFLG USED TO
C                                       CONTROL WHETHER OUTPUT IS SAVED
C                                       WITH SUBSETTING OR IS SAVED
C                                       AS A "FULL" MATRIX.  E.G.,
C                                       MATRIX ADDITION MAINTAINS THE
C                                       SUBSET WHEN SAVING THE OUTPUT,
C                                       WHILE CORRELATION MATRIX IS
C                                       SAVED AS A "FULL" MATRIX.
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP MEANS
C     UPDATED         --SEPTEMBER 1998. MATRIX GROUP SD
C     UPDATED         --SEPTEMBER 1998. POOLED VARIANCE-COVARIANCE
C                                       MATRIX (MORE THAN 2 GROUPS)
C     UPDATED         --OCTOBER   1998. SPLIT INTO 2 ROUTINES
C     UPDATED         --MAY       2002. MULTIVARIATE NORM RAND NUMB
C     UPDATED         --MAY       2002. MULTINOMIAL RAND NUMB
C     UPDATED         --MAY       2002. WISHART RAND NUMB
C     UPDATED         --JUNE      2002. CATCHER MATRIX
C     UPDATED         --JULY      2002. ESSENTIALLY REWRITE FOR
C                                       BETTER CLARITY (MAKE USE
C                                       OF SEVERAL SUBROUTINES)
C     UPDATED         --JULY      2002. CREATE MATRIX
C     UPDATED         --MAY       2003. MULTIVARIATE T RAND NUMB
C     UPDATED         --MAY       2003. INDEPENDENT UNIFORM RAND NUMB
C     UPDATED         --MAY       2003. DIRIHLET RAND NUMB
C     UPDATED         --MAY       2003. MULTIVARIATE NORM CDF
C     UPDATED         --MAY       2003. MULTIVARIATE T CDF
C     UPDATED         --MAY       2003. ARGUMENT LIST TO MATAR3
C     UPDATED         --MAY       2003. FIX MULTINOMIAL RANDOM NUMBERS
C     UPDATED         --SEPTEMBER 2003. CORRELATED MULTIVARIATE
C                                       UNIFORM RANDOM NUMBERS
C     UPDATED         --JUNE      2005. MATRIX SUM
C     UPDATED         --JUNE      2005. MATRIX PARTITION 
C     UPDATED         --MARCH     2006. MATRIX BIN (NEED TO MODIFY
C                                       CALL LIST TO MATAR3)
C     UPDATED         --MARCH     2006. MATRIX LOWER TRUNCATE
C     UPDATED         --MARCH     2006. MATRIX UPPER TRUNCATE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASL7
      CHARACTER*4 ICASS7
      CHARACTER*4 IFTEXP
      CHARACTER*4 IFTORD
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      PARAMETER(MAXCAS=30)
      PARAMETER(MAXCA2=3)
C
      CHARACTER*4 NEWNAM(MAXCA2)
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWRITE
      CHARACTER*4 ITCASE
      CHARACTER*4 IMCASE
      CHARACTER*4 IMSUBC
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ILEFT(MAXCA2)
      CHARACTER*4 ILEF2(MAXCA2)
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IMATSW
      CHARACTER*4 ITYP91
C
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IHMAT1
      CHARACTER*4 IHMAT2
C
      CHARACTER*4 ITYPA(MAXCAS)
C
      CHARACTER*4 IHCV11
      CHARACTER*4 IHCV12
      CHARACTER*4 IHCV21
      CHARACTER*4 IHCV22
      CHARACTER*4 IHCV31
      CHARACTER*4 IHCV32
C
      CHARACTER*4 IUPFLG
      CHARACTER*4 IFLGLL
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 IRELAT
C
      INTEGER ILISL(MAXCA2)
      INTEGER ICOLL(MAXCA2)
      INTEGER ILOCR(MAXCAS)
      INTEGER ILISR(MAXCAS)
      INTEGER ICOLR(MAXCAS)
      INTEGER NIRIGH(MAXCAS)
      INTEGER NS(MAXCAS)
      REAL TEMPS(MAXCAS)
C
C---------------------------------------------------------------------
C
C     TOTAL FOR THE COMMON FILES IS 20+200+200=420 (SEPT 1987)
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION TEMP12(2*MAXOBV)
      DIMENSION TEMP91(MAXOBV)
      DIMENSION TEMP92(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
      DIMENSION ITEMP2(MAXOBV)
      DIMENSION ITEMP3(MAXOBV)
      DIMENSION ITEMP4(MAXOBV)
      DIMENSION ITEMP5(MAXOBV)
      DIMENSION ITEMP6(MAXOBV)
      DOUBLE PRECISION DTEMP1(MAXOBV)
      DOUBLE PRECISION DTEMP2(MAXOBV)
      DOUBLE PRECISION DTEMP3(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (GARBAG(IGARB1),TEMP1)
      EQUIVALENCE (GARBAG(IGARB2),TEMP2)
      EQUIVALENCE (GARBAG(IGARB3),TEMP3)
      EQUIVALENCE (GARBAG(IGARB4),TEMP4)
      EQUIVALENCE (GARBAG(IGARB6),TEMP12)
      EQUIVALENCE (GARBAG(IGARB8),TEMP91)
      EQUIVALENCE (GARBAG(IGAR10),TEMP92)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1)
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2)
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3)
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4)
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5)
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6)
      EQUIVALENCE (DGARBG(IDGAR1),DTEMP1)
      EQUIVALENCE (DGARBG(IDGAR2),DTEMP2)
      EQUIVALENCE (DGARBG(IDGAR3),DTEMP3)
C
      DIMENSION TEMPM1(MAXTOM)
      DIMENSION TEMPM2(MAXTOM)
      DIMENSION TEMM91(MAXTOM)
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(1),TEMPM1)
      PARAMETER (IGINC=MAXTOM)
      PARAMETER (IGT1=1+IGINC)
      EQUIVALENCE (G2RBAG(IGT1),TEMPM2)
      PARAMETER (IGT3=IGT1+IGINC)
      EQUIVALENCE (G2RBAG(IGT3),TEMM91)
C
      DIMENSION TEMPV(20)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOSU.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IUPFLG='SUBS'
C
      ISUBN1='DPMA'
      ISUBN2='T2  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      ILOCR(1)=ILOCV
      DO10I=2,MAXCAS
        ILOCR(I)=ILOCR(I-1)+1
   10 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      DO12I=1,MAXCA2
        NEWNAM(I)='NO'
   12 CONTINUE
      NUMVAL=1
C
      IMATSW='NO'
C
      ITYP91='VECT'
      SCAL91=(-999.0)
C
      DO14I=1,MAXCAS
        ITYPA(I)='VARI'
        TEMPS(I)=(-999.0)
        ILISR(I)=(-999)
   14 CONTINUE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAT2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3,IBUGQ,ISUBRO
   52   FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASL7,ILOCV
   53   FORMAT('ICASL7,ILOCV = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM(1)='NO'
C
C     ***************************************************************
C     **  STEP 2A--                                                 *
C     **  EXAMINE THE LEFT-HAND SIDE--                              *
C     **  IS THE VARIABLE NAME TO LEFT OF = SIGN                    *
C     **  ALREADY IN THE NAME LIST?    AS A VARIABLE?               *
C     **  NOTE THAT     ILEFT(I)   IS THE NAME OF THE VARIABLE      *
C     **  ON THE LEFT.                                              *
C     **  NOTE THAT     ILISL(I)  IS THE LINE IN THE TABLE          *
C     **  OF THE NAME ON THE LEFT.                                  *
C     **  NOTE THAT     ICOLL(I)  IS THE DATA COLUMN (1 TO 12)      *
C     **  FOR THE NAME OF THE LEFT.                                 *
C     ***************************************************************
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASE=1
      CALL DPMAT6(ICASL7,ICASE,MAXCA2,
     1            ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1            NUMVAL,NIOLD,
     1            IBUGA3,ISUBRO,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF' .OR.
     1   ICASL7.EQ.'MQRD' .OR. ICASL7.EQ.'MATB' .OR.
     1   ICASL7.EQ.'MARB')THEN
        ICASE=2
        CALL DPMAT6(ICASL7,ICASE,MAXCA2,
     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1              NUMVAL,NIOLD,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(ICASL7.EQ.'MASD' .OR.  ICASL7.EQ.'MASF')THEN
        ICASE=3
        CALL DPMAT6(ICASL7,ICASE,MAXCA2,
     1              ILEFT,ILEF2,NEWNAM,ILISL,ICOLL,
     1              NUMVAL,NIOLD,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,491)
  491   FORMAT('AT THE END OF STEP 2--')
        CALL DPWRST('XXX','BUG ')
        DO494I=1,MAXCA2
        WRITE(ICOUT,492)ILEFT(I),ILEF2(I),NEWNAM(I),NUMNAM,
     1                  ILISL(I),NUMCOL,ICOLL(I),NIOLD
        CALL DPWRST('XXX','BUG ')
  492   FORMAT('ILEFT(I),ILEFT(I),NEWNAM(I),NUMNAM,ILISL(I),',
     1         'NUMCOL,ICOLL(I),NIOLD = ',A4,A4,2X,A4,2X,5I8)
  494   CONTINUE
      ENDIF
C
C     ****************************************************************
C     **  STEP 4--                                                   *
C     **  EXAMINE THE RIGHT-HAND SIDE--                              *
C     **  HAS EACH VARIABLE ON THE RIGHT                             *
C     **  ALREADY BEEN DEFINED?                                      *
C     **  NOTE THAT     ILISR(1), ILISR(2), ILISR(3), ILISR(4)               *
C     **  IS THE LINE IN THE TABLE                                   *
C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
C     **  RESPECTIVELY.                                              *
C     **  NOTE THAT     ICOLR(1), ICOLR(2), ICOLR3, ICOLR4               *
C     **  IS THE DATA COLUMN (1 TO 10+6)                             *
C     **  OF THE FIRST, SECOND, THIRD, FOURTH VARIABLE ON THE RIGHT, *
C     **  RESPECTIVELY.                                              *
C     ****************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 4.1--                            **
C               **  DETERMINE THE NUMBER OF VARIABLES     **
C               **  ON THE RIGHT--1, 2, 3, OR 4           **
C               ********************************************
C
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,1021)ICASL7,NUMARG
 1021   FORMAT('ICASL7,NUMARG = ',A4,2X,I2)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IMATSW='YES'
      NUMVAR=1
C
      IF(ICASL7.EQ.'MAIN'.OR.ICASL7.EQ.'MATR'.OR.ICASL7.EQ.'MAEN'.OR.
     1   ICASL7.EQ.'MAAJ'.OR.ICASL7.EQ.'MACE'.OR.ICASL7.EQ.'MAVC'.OR.
     1   ICASL7.EQ.'MAEA'.OR.ICASL7.EQ.'VINF'.OR.ICASL7.EQ.'MACO'.OR.
     1   ICASL7.EQ.'CIND'.OR.ICASL7.EQ.'MAEE'.OR.ICASL7.EQ.'MAPC'.OR.
     1   ICASL7.EQ.'MAP1'.OR.ICASL7.EQ.'MAP2'.OR.ICASL7.EQ.'MAP3'.OR.
     1   ICASL7.EQ.'MAP4'.OR.ICASL7.EQ.'MAP5'.OR.ICASL7.EQ.'MAP6'.OR.
     1   ICASL7.EQ.'MAP7'.OR.ICASL7.EQ.'MAP8'.OR.ICASL7.EQ.'MAP9'.OR.
     1   ICASL7.EQ.'MA10'.OR.(ICASL7.EQ.'MARA'.AND.NUMARG.EQ.5))THEN
        NUMVAR=1
      ELSEIF(
     1   ICASL7.EQ.'MADE'.OR.ICASL7.EQ.'MAPE'.OR.ICASL7.EQ.'MASV'.OR.
     1   ICASL7.EQ.'MASN'.OR.ICASL7.EQ.'MASR'.OR.ICASL7.EQ.'MASD'.OR.
     1   ICASL7.EQ.'MANR'.OR.ICASL7.EQ.'MANC'.OR.ICASL7.EQ.'MATC'.OR.
     1   ICASL7.EQ.'MASF'.OR.ICASL7.EQ.'MACH'.OR.ICASL7.EQ.'MADI'.OR.
     1   ICASL7.EQ.'MAMM'.OR.ICASL7.EQ.'MADM'.OR.ICASL7.EQ.'DIMA'.OR.
     1   ICASL7.EQ.'MAVT'.OR.ICASL7.EQ.'MATI'.OR.ICASL7.EQ.'MPIN'.OR.
     1   ICASL7.EQ.'MDER'.OR.ICASL7.EQ.'MDEC'.OR.ICASL7.EQ.'MDMR'.OR.
     1   ICASL7.EQ.'MDMC'.OR.ICASL7.EQ.'MDBR'.OR.ICASL7.EQ.'MDBC'.OR.
     1   ICASL7.EQ.'MDKR'.OR.ICASL7.EQ.'MDKC'.OR.ICASL7.EQ.'MDCR'.OR.
     1   ICASL7.EQ.'MDCC'.OR.ICASL7.EQ.'MRSC'.OR.ICASL7.EQ.'MCSC'.OR.
     1   ICASL7.EQ.'MROW'.OR.ICASL7.EQ.'MCOL'.OR.ICASL7.EQ.'MGRA'.OR.
     1   ICASL7.EQ.'MATB'.OR.ICASL7.EQ.'MARB'.OR.
     1   ICASL7.EQ.'MDIP'.OR.ICASL7.EQ.'MQRD'.OR.ICASL7.EQ.'MSUM')THEN
        NUMVAR=1
      ELSEIF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.
     1       ICASL7.EQ.'MAMU'.OR.ICASL7.EQ.'MASO'.OR.
     1       (ICASL7.EQ.'MARA'.AND.NUMARG.EQ.6).OR.
     1       ICASL7.EQ.'MASS'.OR.ICASL7.EQ.'MARW'.OR.
     1       ICASL7.EQ.'MAAU'.OR.
     1       ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ'.OR.
     1       ICASL7.EQ.'MAAR'.OR.ICASL7.EQ.'MADR'.OR.
     1       ICASL7.EQ.'MATS'.OR.ICASL7.EQ.'MAIS'.OR.
     1       ICASL7.EQ.'MQFO'.OR.ICASL7.EQ.'MALC'.OR.
     1       ICASL7.EQ.'MAGM'.OR.ICASL7.EQ.'MAGS'.OR.
     1       ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2'.OR.
     1       ICASL7.EQ.'MPDF'.OR.ICASL7.EQ.'DPDF'.OR.
     1       ICASL7.EQ.'INRN'.OR.ICASL7.EQ.'DLPD'.OR.
     1       ICASL7.EQ.'MPVC'.OR.ICASL7.EQ.'DIRN')THEN
        NUMVAR=2
      ELSEIF(ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.
     1       ICASL7.EQ.'MACF'.OR.ICASL7.EQ.'MAEL'.OR.
     1       (ICASL7.EQ.'MADF'.AND.NUMARG.EQ.7).OR.
     1       ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MVRN'.OR.
     1       ICASL7.EQ.'MURN'.OR.
     1       ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'IURN'.OR.
     1       ICASL7.EQ.'MPAR')THEN
        NUMVAR=3
      ELSEIF((ICASL7.EQ.'MADF'.AND.NUMARG.EQ.8).OR.
     1       ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'MATD'.OR.
     1       ICASL7.EQ.'MTRN')THEN
        NUMVAR=4
      ELSEIF(ICASL7.EQ.'CRMA')THEN
        ISTRT=5
        ILAST=NUMARG
        DO1051I=5,NUMARG
          IHRIGH=IHARG(I)
          IHRIG2=IHARG2(I)
          IF(IHRIGH.EQ.'SUBS'.AND.IHRIG2.EQ.'ET  ')THEN
            ILAST=I-1
            GOTO1054
          ELSEIF(IHRIGH.EQ.'EXCE'.AND.IHRIG2.EQ.'PT  ')THEN
            ILAST=I-1
            GOTO1054
          ELSEIF(IHRIGH.EQ.'FOR '.AND.IHRIG2.EQ.'    ')THEN
            ILAST=I-1
            GOTO1054
          ENDIF
 1051   CONTINUE
 1054   CONTINUE
        NUMVAR=ILAST-ISTRT+1
      ELSEIF(ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF')THEN
        ISTRT=6
        ILAST=NUMARG
        DO1061I=ISTRT,NUMARG
          IHRIGH=IHARG(I)
          IHRIG2=IHARG2(I)
          IF(IHRIGH.EQ.'SUBS'.AND.IHRIG2.EQ.'ET  ')THEN
            ILAST=I-1
            GOTO1064
          ELSEIF(IHRIGH.EQ.'EXCE'.AND.IHRIG2.EQ.'PT  ')THEN
            ILAST=I-1
            GOTO1064
          ELSEIF(IHRIGH.EQ.'FOR '.AND.IHRIG2.EQ.'    ')THEN
            ILAST=I-1
            GOTO1064
          ENDIF
 1061   CONTINUE
 1064   CONTINUE
        NUMVAR=ILAST-ISTRT+1
        IF(ICASL7.EQ.'NCDF')THEN
          IF(NUMVAR.EQ.3)THEN
            IFLGLL='ON'
          ELSEIF(NUMVAR.EQ.2)THEN
            IFLGLL='OFF'
          ELSE
            WRITE(ICOUT,1066)
 1066       FORMAT('***** ERROR FOR MULTIVARIATE NORMAL CDF--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1068)NUMVAR
 1068       FORMAT('      EITHER 2 OR 3 ARGUMENTS EXPECTED, ',I8,
     1             'FOUND.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ELSEIF(ICASL7.EQ.'TCDF')THEN
          IF(NUMVAR.EQ.4)THEN
            IFLGLL='ON'
          ELSEIF(NUMVAR.EQ.3)THEN
            IFLGLL='OFF'
          ELSE
            WRITE(ICOUT,1076)
 1076       FORMAT('***** ERROR FOR MULTIVARIATE T CDF--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1078)NUMVAR
 1078       FORMAT('      EITHER 3 OR 4 ARGUMENTS EXPECTED, ',I8,
     1             'FOUND.')
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ENDIF
C
      IMATSW='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,1091)ICASL7,NUMVAR
 1091   FORMAT('ICASL7,NUMVAR = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************************
C               **  STEP 5.1--                       **
C               **  EXAMINE THE VARIABLES            **
C               **  ON THE RIGHT.                    **
C               ***************************************
C
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG1=0
      IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
     1   ICASL7.EQ.'JAIN'.OR.ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ')THEN
         IFLAG1=1
      ENDIF
      ICASE=1
      CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1IFLAG1,ATEMP,ITEMP,
     1IBUGA3,ISUBRO,IFOUND,IERROR)
      IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(NUMVAR.GE.2)THEN
        IFLAG1=0
        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
     1     ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.ICASL7.EQ.'MACF'.OR.
     1     ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MARA'.OR.ICASL7.EQ.'MARW'.OR.
     1     ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'JAIN'.OR.
     1     ICASL7.EQ.'DIRN'.OR.ICASL7.EQ.'TCDF'.OR.ICASL7.EQ.'INRN'.OR.
     1     ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'MATZ'.OR.ICASL7.EQ.'MAUZ'.OR.
     1     ICASL7.EQ.'EXPS'.OR.ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MURN')
     1  THEN
          IFLAG1=1
        ENDIF
          ICASE=2
          CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1                IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1                IFLAG1,ATEMP,ITEMP,
     1                IBUGA3,ISUBRO,IFOUND,IERROR)
          IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
          IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMVAR.GE.3)THEN
        IFLAG1=0
        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MAMU'.OR.
     1     ICASL7.EQ.'MASM'.OR.ICASL7.EQ.'MAMI'.OR.ICASL7.EQ.'MACF'.OR.
     1     ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MARE'.OR.
     1     ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MVRN'.OR.ICASL7.EQ.'MURN'.OR.
     1     ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MURN'.OR.
     1     ICASL7.EQ.'MPAR'.OR.
     1     ICASL7.EQ.'IURN'.OR.ICASL7.EQ.'MTRN')
     1  THEN
           IFLAG1=1
        ENDIF
        ICASE=3
        CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1              IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1              IFLAG1,ATEMP,ITEMP,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMVAR.GE.4)THEN
        IFLAG1=0
        IF(ICASL7.EQ.'MAAD'.OR.ICASL7.EQ.'MASU'.OR.ICASL7.EQ.'MARA'.OR.
     1     ICASL7.EQ.'MAMU'.OR.ICASL7.EQ.'MADF'.OR.ICASL7.EQ.'MARE'.OR.
     1     ICASL7.EQ.'MURN'.OR.ICASL7.EQ.'MTRN')THEN
           IFLAG1=1
        ENDIF
        ICASE=4
        CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1              IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1              IFLAG1,ATEMP,ITEMP,
     1              IBUGA3,ISUBRO,IFOUND,IERROR)
        IF(ITYPA(ICASE).EQ.'MATR')IMATSW='YES'
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C  5 VARIABLES OR MORE CURRENTLY ONLY RELEVANT FOR THE
C  "CREATE MATRIX" COMMAND.
C
      IF(NUMVAR.GE.5)THEN
        DO1110ICASE=5,NUMVAR
          IFLAG1=0
          CALL DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1                IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1                IFLAG1,ATEMP,ITEMP,
     1                IBUGA3,ISUBRO,IFOUND,IERROR)
 1110   CONTINUE
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C     *******************************
C     **  STEP 7--                 **
C     **  DETERMINE THE SUBCASE    **
C     **  AND BRANCH ACCORDINGLY.  **
C     *******************************
C
 7000 CONTINUE
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,7003)NUMVAR,NUMARG
 7003   FORMAT('7008--NUMVAR,NUMARG = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO7005I=1,NUMVAR
        WRITE(ICOUT,7008)I,ITYPA(I),ILOCR(I)
 7008   FORMAT('7008-I,ITYPA(I),ILOCR(I) = ',I4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
 7005   CONTINUE
        WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR))
 7006   FORMAT('IHARG(ILOCR(NUMVAR)),IHARG2(ILOCR(NUMVAR)) = ',2A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
     1                   IHARG2(ILOCR(NUMVAR)+1)
 7007   FORMAT('IHARG(ILOCR(NUMVAR)+1),IHARG2(ILOCR(NUMVAR)+1) = ',
     1         2A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(ICASL7.NE.'CRMA'.AND.NUMVAR.GE.5)THEN
        WRITE(ICOUT,7011)
 7011   FORMAT('***** ERROR IN DPMAT2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7012)
 7012   FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7000--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7013)
 7013   FORMAT('      THERE WERE 5 OR MORE VARIABLES ON THE RIGHT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7014)
 7014   FORMAT('      HAND SIDE OF THE EQUAL SIGN.  THERE ARE NO')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7015)
 7015   FORMAT('      MATRIX  LET  SYNTAXES (EXCEPT CREATE MATRIX)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7016)
 7016   FORMAT('      WITH THAT MANY VARIABLES ON THE RIGHT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7017)
 7017   FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7019)(IANS(I),I=1,MAX(100,IWIDTH))
 7019   FORMAT(100A1)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO19000
      ENDIF
C
      IF(ILOCR(NUMVAR).EQ.NUMARG)GOTO8000
C
      IF(ILOCR(NUMVAR).LT.NUMARG)THEN
        IT1=ILOCR(NUMVAR+1)
        IF(IHARG(IT1).EQ.'SUBS'.AND.IHARG2(IT1).EQ.'ET  ')GOTO9000
C
        IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
          WRITE(ICOUT,7009)
 7009     FORMAT('AFTER TEST FOR SUBSET')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7006)IHARG(ILOCR(NUMVAR)),
     1                     IHARG2(ILOCR(NUMVAR))
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7007)IHARG(ILOCR(NUMVAR)+1),
     1                     IHARG2(ILOCR(NUMVAR)+1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        IF(IHARG(IT1).EQ.'EXCE'.AND.IHARG2(IT1).EQ.'PT  ')GOTO9000
        IF(IHARG(IT1).EQ.'FOR '.AND.IHARG2(IT1).EQ.'    ')GOTO10000
      ENDIF
C
      WRITE(ICOUT,7081)
 7081 FORMAT('***** ERROR 7081 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7082)
 7082 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND AT 7082--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7083)
 7083 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7084)(IANS(I),I=1,MIN(100,IWIDTH))
 7084 FORMAT(100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7088)ILOCV,NUMARG,NUMVAR
 7088 FORMAT('ILOCV,NUMARG,NUMVAR = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO7089I=1,NUMVAR
      WRITE(ICOUT,7086)I,ILOCR(I)
 7086 FORMAT('I,ILOCR(I) = ',I4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 7089 CONTINUE
      IERROR='YES'
      GOTO19000
C
C     ************************************************
C     **  STEP 8--                                  **
C     **  TREAT THE FULL VARIABLE CASE.             **
C     **  EXAMPLE--LET Y = COVARIANCE MATRIX X      **
C     **  THEN JUMP TO STEP NUMBER 10 BELOW         **
C     **  FOR THE LIST UPDATING AND                 **
C     **  FOR SOME INFORMATIVE PRINTING.            **
C     ************************************************
C
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,8011)NINEW,NIRIGH(1)
 8011   FORMAT('NINEW,NIRIGH(1) = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ICASEQ='FULL'
      NIOLD=NIRIGH(1)
      IF(NUMVAR.GE.2)THEN
        DO8020I=2,NUMVAR
          IF(NIRIGH(I).GT.NIOLD)NIOLD=NIRIGH(I)
 8020   CONTINUE
      ENDIF
      NINEW=NIOLD
      DO8100I=1,NINEW
      ISUB(I)=1
 8100 CONTINUE
      GOTO11000
C
C     ****************************************************************
C     **  STEP 9--                                                   *
C     **  TREAT THE PARTIAL VARIABLE SUBSET CASE.                    *
C     **  EXAMPLE--LET Y = SORT X     SUBSET 2 3 5                   *
C     **         --LET Y(I) = SORT X  SUBSET 2 3 5                   *
C     **  JUMP TO STEP NUMBER 11 BELOW                               *
C     **  FOR THE ACTUAL MATHEMATICAL OPERATION,                     *
C     **  FOR THE LIST UPDATING, AND                                 *
C     **  FOR SOME INFORMATIVE PRINTING.                             *
C     ****************************************************************
C
 9000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='SUBS'
      ILOCSV=ILOCR(NUMVAR)+2
      IHSET=IHARG(ILOCSV)
      IHSET2=IHARG2(ILOCSV)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,9002)ILOCSV,IHSET,IHSET2
 9002   FORMAT('ILOCSV,IHSET,IHSET2 = ',I8,2X,A4,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      NIOLD=IN(ILOC)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NINEW=NIOLD
      GOTO11000
C
C     ****************************************************************
C     **  STEP 10--                                                  *
C     **  TREAT THE PARTIAL VARIABLE FOR CASE.                       *
C     **  EXAMPLE--LET Y = SORT X     FOR I = 1 2 10                 *
C     **         --LET Y(I) = SORT X  FOR I = 1 2 10                 *
C     **  JUMP TO STEP NUMBER 11 BELOW                               *
C     **  FOR THE ACTUAL MATHEMATICAL OPERATION,                     *
C     **  FOR THE LIST UPDATING, AND                                 *
C     **  FOR SOME INFORMATIVE PRINTING.                             *
C     ****************************************************************
C
10000 CONTINUE
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FOR'
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIFOR=NINEW
      GOTO11000
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE                        **
C               **  MATHEMATICAL OPERATION.              **
C               *******************************************
C
11000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        DO11109I=1,NUMVAR
        WRITE(ICOUT,11101)I,ITYPA(I)
11101   FORMAT('11101--I,ITYPA(I) = ',I4,2X,A4)
        CALL DPWRST('XXX','BUG ')
11109   CONTINUE
      ENDIF
C
      NITEMX=NINEW
      DO11113I=1,MAXCAS
        NS(I)=0
11113 CONTINUE
C
CCCCC CREATE MATRIX HANDLED SEPARATELY, VARIABLES ARE COPIED INTO
CCCCC A MATRIX.
      IF(ICASL7.EQ.'CRMA')THEN
        IMCASE=ICASL7
        IMATSW='YES'
        DO11010K=1,NUMVAR
          IF(ITYPA(K).EQ.'VARI')THEN
            NJ=0
            DO11011I=1,NINEW
              IJ=MAXN*(ICOLR(K)-1)+I
              IF(ISUB(I).EQ.0)GOTO11011
              IF(I.GT.NIRIGH(K))GOTO11019
              NJ=NJ+1
              IF(NJ.GT.MAXROM)GOTO11019
              IJ=MAXN*(ICOLR(K)-1)+I
              IF(ICOLR(K).LE.MAXCOL)TEMPM1((K-1)*MAXROM+NJ)=V(IJ)
              IF(ICOLR(K).EQ.MAXCP1)TEMPM1((K-1)*MAXROM+NJ)=PRED(I)
              IF(ICOLR(K).EQ.MAXCP2)TEMPM1((K-1)*MAXROM+NJ)=RES(I)
              IF(ICOLR(K).EQ.MAXCP3)TEMPM1((K-1)*MAXROM+NJ)=YPLOT(I)
              IF(ICOLR(K).EQ.MAXCP4)TEMPM1((K-1)*MAXROM+NJ)=XPLOT(I)
              IF(ICOLR(K).EQ.MAXCP5)TEMPM1((K-1)*MAXROM+NJ)=X2PLOT(I)
              IF(ICOLR(K).EQ.MAXCP6)TEMPM1((K-1)*MAXROM+NJ)=TAGPLO(I)
11011       CONTINUE
11019       CONTINUE
          ENDIF
11010   CONTINUE
        NR1=NJ
        IF(NR1.GT.MAXROM)NR1=MAXROM
        NR2=0
        NR3=0
        NC1=NUMVAR
        NC2=0
        NC3=0
        GOTO11189
      ENDIF
C
      DO11110K=1,MIN(NUMVAR,4)
        IF(ITYPA(K).EQ.'VARI')THEN
          DO11111I=1,NINEW
            IJ=MAXN*(ICOLR(K)-1)+I
CCCCC       IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
CCCCC         WRITE(ICOUT,11112)I,NS(K),NINEW,ISUB(I),IJ,V(IJ)
11112        FORMAT('I,NS(K),NINEW,ISUB(I),IJ,V(IJ) = ',5I8,F12.5)
CCCCC         CALL DPWRST('XXX','BUG ')
CCCCC       ENDIF
            IF(ISUB(I).EQ.0)GOTO11111
            IF(I.GT.NIRIGH(K))GOTO11119
            NS(K)=NS(K)+1
            IJ=MAXN*(ICOLR(K)-1)+I
            IF(ICOLR(K).LE.MAXCOL)TEMP4(NS(K))=V(IJ)
            IF(ICOLR(K).EQ.MAXCP1)TEMP4(NS(K))=PRED(I)
            IF(ICOLR(K).EQ.MAXCP2)TEMP4(NS(K))=RES(I)
            IF(ICOLR(K).EQ.MAXCP3)TEMP4(NS(K))=YPLOT(I)
            IF(ICOLR(K).EQ.MAXCP4)TEMP4(NS(K))=XPLOT(I)
            IF(ICOLR(K).EQ.MAXCP5)TEMP4(NS(K))=X2PLOT(I)
            IF(ICOLR(K).EQ.MAXCP6)TEMP4(NS(K))=TAGPLO(I)
11111     CONTINUE
11119     CONTINUE
          IF(K.EQ.1)THEN
            DO11126J=1,NS(K)
              TEMP1(J)=TEMP4(J)
CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
CCCCC           WRITE(ICOUT,11137)K,J,TEMP1(J)
11137           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
CCCCC           CALL DPWRST('XXX','BUG ')
CCCCC         ENDIF
11126       CONTINUE
          ELSEIF(K.EQ.2)THEN
            DO11127J=1,NS(K)
              TEMP2(J)=TEMP4(J)
CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
CCCCC           WRITE(ICOUT,11138)K,J,TEMP1(J)
11138           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
CCCCC           CALL DPWRST('XXX','BUG ')
CCCCC         ENDIF
11127       CONTINUE
          ELSEIF(K.EQ.3)THEN
            DO11128J=1,NS(K)
              TEMP3(J)=TEMP4(J)
CCCCC         IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
CCCCC           WRITE(ICOUT,11139)K,J,TEMP1(J)
11139           FORMAT('K,J,TEMP1(J) = ',2I8,E15.7)
CCCCC           CALL DPWRST('XXX','BUG ')
CCCCC         ENDIF
11128       CONTINUE
          ENDIF
        ENDIF
11110 CONTINUE
11199 CONTINUE
C
C     -----BEGIN MATRIX COPY-----
C
      IF(ICASL7.EQ.'MADF')IMATSW='YES'
      IF(ICASL7.EQ.'DIMA')IMATSW='YES'
      IF(ICASL7.EQ.'MAVT')IMATSW='YES'
      IF(IMATSW.EQ.'NO')GOTO11290
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        IF(ITYPA(1).EQ.'MATR')THEN
          WRITE(ICOUT,11201)ILISR(1),ICOLR(1),IVALUE(ILISR(1)),
     1                      IVALU2(ILISR(1))
11201     FORMAT('11201--ILISR(1),ICOLR(1),IVALUE(ILISR(1)),',
     1           'IVALU2(ILISR(1))=',14I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        DO11208I=1,MIN(4,NUMVAR)
          WRITE(ICOUT,11202)I,ITYPA(I)
11202     FORMAT('11202--I,ITYPA(I) = ',I4,2X,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11204)I,ILISR(I),IVALU2(ILISR(I))
11204     FORMAT('11204--I,ILISR(I),IVALU2(I) = ',3I8)
          CALL DPWRST('XXX','BUG ')
11208   CONTINUE
      ENDIF
C
      NC1=1
      NC2=1
      NC3=1
      IF(ITYPA(1).EQ.'MATR'.AND.NUMVAR.GE.1)
     1NC1=IVALU2(ILISR(1))-IVALUE(ILISR(1))+1
      IF(ITYPA(2).EQ.'MATR'.AND.NUMVAR.GE.2)
     1NC2=IVALU2(ILISR(2))-IVALUE(ILISR(2))+1
      IF(ITYPA(3).EQ.'MATR'.AND.NUMVAR.GE.3)
     1NC3=IVALU2(ILISR(3))-IVALUE(ILISR(3))+1
      IF(ICASL7.EQ.'MADF')NC1=TEMPS(3)+0.1
C
      IF(NUMVAR.LE.0)GOTO11219
      IF(ITYPA(1).EQ.'MATR'.OR.ICASL7.EQ.'MADF')THEN
        NLOOP=NC1
        IF(NLOOP.LT.1)NLOOP=1
        DO11211JLOOP=1,NLOOP
          NS(1)=0
          DO11212I=1,NINEW
          IJ=MAXN*(ICOLR(1)-1+JLOOP-1)+I
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
            WRITE(ICOUT,11213)I,JLOOP,NS(1),NINEW,ISUB(I),IJ,V(IJ)
11213       FORMAT('I,JLOOP,NS(1),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(ISUB(I).EQ.0)GOTO11212
          IF(I.GT.NIRIGH(1))GOTO11214
          NS(1)=NS(1)+1
          IJ=MAXN*(ICOLR(1)-1+JLOOP-1)+I
          IF(ICOLR(1).LE.MAXCOL)TEMPM1((JLOOP-1)*MAXROM+NS(1))=V(IJ)
          IF(ICOLR(1).EQ.MAXCP1)TEMPM1((JLOOP-1)*MAXROM+NS(1))=PRED(I)
          IF(ICOLR(1).EQ.MAXCP2)TEMPM1((JLOOP-1)*MAXROM+NS(1))=RES(I)
          IF(ICOLR(1).EQ.MAXCP3)TEMPM1((JLOOP-1)*MAXROM+NS(1))=YPLOT(I)
          IF(ICOLR(1).EQ.MAXCP4)TEMPM1((JLOOP-1)*MAXROM+NS(1))=XPLOT(I)
          IF(ICOLR(1).EQ.MAXCP5)TEMPM1((JLOOP-1)*MAXROM+NS(1))=X2PLOT(I)
          IF(ICOLR(1).EQ.MAXCP6)TEMPM1((JLOOP-1)*MAXROM+NS(1))=TAGPLO(I)
11212     CONTINUE
11214     CONTINUE
11211   CONTINUE
      ENDIF
11219 CONTINUE
C
      IF(NUMVAR.LE.1)GOTO11229
      IF(ITYPA(2).EQ.'MATR')THEN
        NLOOP=NC2
        IF(NLOOP.LT.1)NLOOP=1
        DO11221JLOOP=1,NLOOP
          NS(2)=0
          DO11222I=1,NINEW
          IJ=MAXN*(ICOLR(2)-1+JLOOP-1)+I
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
            WRITE(ICOUT,11223)I,JLOOP,NS(2),NINEW,ISUB(I),IJ,V(IJ)
11223       FORMAT('I,JLOOP,NS(2),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(ISUB(I).EQ.0)GOTO11222
          IF(I.GT.NIRIGH(2))GOTO11224
          NS(2)=NS(2)+1
          IJ=MAXN*(ICOLR(2)-1+JLOOP-1)+I
          IF(ICOLR(2).LE.MAXCOL)TEMPM2((JLOOP-1)*MAXROM+NS(2))=V(IJ)
          IF(ICOLR(2).EQ.MAXCP1)TEMPM2((JLOOP-1)*MAXROM+NS(2))=PRED(I)
          IF(ICOLR(2).EQ.MAXCP2)TEMPM2((JLOOP-1)*MAXROM+NS(2))=RES(I)
          IF(ICOLR(2).EQ.MAXCP3)TEMPM2((JLOOP-1)*MAXROM+NS(2))=YPLOT(I)
          IF(ICOLR(2).EQ.MAXCP4)TEMPM2((JLOOP-1)*MAXROM+NS(2))=XPLOT(I)
          IF(ICOLR(2).EQ.MAXCP5)TEMPM2((JLOOP-1)*MAXROM+NS(2))=X2PLOT(I)
          IF(ICOLR(2).EQ.MAXCP6)TEMPM2((JLOOP-1)*MAXROM+NS(2))=TAGPLO(I)
11222     CONTINUE
11224     CONTINUE
11221   CONTINUE
      ENDIF
11229 CONTINUE
C
      IF(NUMVAR.LE.2)GOTO11239
        IF(ITYPA(3).EQ.'MATR')THEN
        NLOOP=NC3
        IF(NLOOP.LT.1)NLOOP=1
        DO11231JLOOP=1,NLOOP
          NS(3)=0
          DO11232I=1,NINEW
          IJ=MAXN*(ICOLR(3)-1+JLOOP-1)+I
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
            WRITE(ICOUT,11233)I,JLOOP,NS(3),NINEW,ISUB(I),IJ,V(IJ)
11233       FORMAT('I,JLOOP,NS(3),NINEW,ISUB(I),IJ,V(IJ) = ',6I8,F12.5)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IF(ISUB(I).EQ.0)GOTO11232
          IF(I.GT.NIRIGH(3))GOTO11234
          NS(3)=NS(3)+1
          IJ=MAXN*(ICOLR(3)-1+JLOOP-1)+I
          IF(ICOLR(3).LE.MAXCOL)TEMM91((JLOOP-1)*MAXROM+NS(3))=V(IJ)
          IF(ICOLR(2).EQ.MAXCP1)TEMM91((JLOOP-1)*MAXROM+NS(3))=PRED(I)
          IF(ICOLR(2).EQ.MAXCP2)TEMM91((JLOOP-1)*MAXROM+NS(3))=RES(I)
          IF(ICOLR(2).EQ.MAXCP3)TEMM91((JLOOP-1)*MAXROM+NS(3))=YPLOT(I)
          IF(ICOLR(2).EQ.MAXCP4)TEMM91((JLOOP-1)*MAXROM+NS(3))=XPLOT(I)
          IF(ICOLR(2).EQ.MAXCP5)TEMM91((JLOOP-1)*MAXROM+NS(3))=X2PLOT(I)
          IF(ICOLR(2).EQ.MAXCP6)TEMM91((JLOOP-1)*MAXROM+NS(3))=TAGPLO(I)
11232     CONTINUE
11234     CONTINUE
11231   CONTINUE
      ENDIF
11239 CONTINUE
C
11290 CONTINUE
C
C     -----END MATRIX COPY-----
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,11291)ICOLL(1),ICOLR(1),ICOLR(2),ICOLR(3),
     1                    NS(1),NS(2),NS(3)
11291   FORMAT('11291--ICOLL(1),ICOLR(1),ICOLR(2),ICOLR(3),',
     1         'NS(1),NS(2),NS(3) = ',7I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11292)NINEW,ICASL7,ICASEQ
11292   FORMAT('11292--NINEW,ICASL7,ICASEQ = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        DO11294I=1,NUMVAR
        WRITE(ICOUT,11293)I,ITYPA(I)
11293   FORMAT('11293--I,ITYPA(I) =',I4,2X,A4)
        CALL DPWRST('XXX','BUG ')
11294   CONTINUE
        WRITE(ICOUT,11295)NS(1),NS(2),NS(3),NS(4)
11295   FORMAT('11295--NS(1),NS(2),NS(3),NS(4) = ',4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11296)IMATSW,ICASL7
11296   FORMAT('11296--IMATSW,ICASL7 = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
C     -----MATRIX SECTION-----
C
11880 CONTINUE
      IMCASE=ICASL7
      IUPFLG='FULL'
      NR1=1
      NR2=1
      NR3=1
      IF(ITYPA(1).EQ.'MATR'.AND.NUMVAR.GE.1)NR1=NS(1)
      IF(ITYPA(2).EQ.'MATR'.AND.NUMVAR.GE.2)NR2=NS(2)
      IF(ITYPA(3).EQ.'MATR'.AND.NUMVAR.GE.3)NR3=NS(3)
      IF(ICASL7.EQ.'MADF')NR1=TEMPS(2)+0.1
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
        WRITE(ICOUT,11881)NS(1),NS(2),NS(3),NR1,NC1,NR2,NC2,NR3,NC3
11881   FORMAT('NS(1),NS(2),NS(3),NR1,NC1,NR2,NC2,NR3,NC3 = ',9I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
11189 CONTINUE
      IF(ICASL7.EQ.'MASV'.OR.ICASL7.EQ.'MASD'.OR.ICASL7.EQ.'MASF'.OR.
     1   ICASL7.EQ.'MARW'.OR.ICASL7.EQ.'MAEL'.OR.ICASL7.EQ.'MACH'.OR.
     1   ICASL7.EQ.'MAAU'.OR.ICASL7.EQ.'MADI'.OR.ICASL7.EQ.'DIMA'.OR.
     1   ICASL7.EQ.'MARR'.OR.ICASL7.EQ.'MARE'.OR.ICASL7.EQ.'MATD'.OR.
     1   ICASL7.EQ.'MATS'.OR.ICASL7.EQ.'MATI'.OR.ICASL7.EQ.'MAIS')THEN
        CALL MATAR2(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
     1  MAXROM,MAXCOM,
     1  TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),TEMP4,NS(4),
     1  ITEMP1,
     1  TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
     1  IMCASE,IUPFLG,IMSUBC,
     1  ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
     1  TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
     1  IBUGA3,ISUBRO,IERROR)
      ELSEIF(ICASL7.EQ.'MPIN'.OR.ICASL7.EQ.'MQFO'.OR.
     1   ICASL7.EQ.'MALC'.OR.ICASL7.EQ.'MAVT'.OR.ICASL7.EQ.'MAGM'.OR.
     1   ICASL7.EQ.'MAGS'.OR.ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2'.OR.
     1   ICASL7.EQ.'MPVC'.OR.ICASL7.EQ.'MAMM'.OR.ICASL7.EQ.'MAAR'.OR.
     1   ICASL7.EQ.'MADR'.OR.ICASL7.EQ.'MDER'.OR.ICASL7.EQ.'MDEC'.OR.
     1   ICASL7.EQ.'MDMR'.OR.ICASL7.EQ.'MDMC'.OR.ICASL7.EQ.'MDBR'.OR.
     1   ICASL7.EQ.'MDBC'.OR.ICASL7.EQ.'MDKR'.OR.ICASL7.EQ.'MDKC'.OR.
     1   ICASL7.EQ.'MDCR'.OR.ICASL7.EQ.'MDCC'.OR.ICASL7.EQ.'MRSC'.OR.
     1   ICASL7.EQ.'MCSC'.OR.ICASL7.EQ.'MDIP'.OR.ICASL7.EQ.'MADM'.OR.
     1   ICASL7.EQ.'MVRN'.OR.ICASL7.EQ.'MACA'.OR.ICASL7.EQ.'XTXI'.OR.
     1   ICASL7.EQ.'VINF'.OR.ICASL7.EQ.'CIND'.OR.
     1   ICASL7.EQ.'MURN'.OR.ICASL7.EQ.'WIRN'.OR.ICASL7.EQ.'MPDF'.OR.
     1   ICASL7.EQ.'MROW'.OR.ICASL7.EQ.'MCOL'.OR.ICASL7.EQ.'DPDF'.OR.
     1   ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF'.OR.ICASL7.EQ.'DLPD'.OR.
     1   ICASL7.EQ.'MTRN'.OR.ICASL7.EQ.'DIRN'.OR.ICASL7.EQ.'INRN'.OR.
     1   ICASL7.EQ.'MPAR'.OR.ICASL7.EQ.'MGRA'.OR.
     1   ICASL7.EQ.'MATB'.OR.ICASL7.EQ.'MARB'.OR.
     1   ICASL7.EQ.'CRMA'.OR.ICASL7.EQ.'IURN'.OR.ICASL7.EQ.'MSUM')THEN
C
        IHP='P   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          P=2.0
        ELSE
          P=VALUE(ILOCP)
        ENDIF
C
        IHP='ABSE'
        IHP2='PS  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          ABSEPS=0.00005
          IF(ICASL7.EQ.'TCDF')ABSEPS=0.0
        ELSE
          ABSEPS=VALUE(ILOCP)
        ENDIF
C
        IHP='RELE'
        IHP2='PS  '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          RELEPS=0.0
          IF(ICASL7.EQ.'TCDF')RELEPS=0.005
        ELSE
          RELEPS=VALUE(ILOCP)
        ENDIF
C
        IRELAT='OFF'
        IF(ICASL7.EQ.'MARB')IRELAT='ON'
        CLWID=CLWIDT(1)
        XSTART=CLLIMI(1)
        XSTOP=CLLIMI(2)
C
        CALL MATAR3(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
     1  MAXROM,MAXCOM,MAXOBV,
     1  TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),TEMP4,NS(4),TEMP12,
     1  ITEMP1,
     1  DTEMP1,DTEMP2,DTEMP3,
     1  P,ABSEPS,RELEPS,ERRS,
     1  TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
     1  ASIG90,ASIG95,ASIG99,ASG995,
     1  IMCASE,IUPFLG,IMSUBC,
     1  ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
     1  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1  TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
     1  ICASS7,
     1  IRELAT,CLWID,XSTART,XSTOP,
     1  IBUGA3,ISUBRO,IERROR)
C
        IF(ICASL7.EQ.'MHT1'.OR.ICASL7.EQ.'MHT2')THEN
          IHP='B90 '
          IHP2='    '
          VALUE0=ASIG90
          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IHP='B95 '
          IHP2='    '
          VALUE0=ASIG95
          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IHP='B99 '
          IHP2='    '
          VALUE0=ASIG99
          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
C
          IHP='B995'
          IHP2='    '
          VALUE0=ASG995
          CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
     1    IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1    IANS,IWIDTH,IBUGA3,IERROR)
        ENDIF
C
      ELSE
        IHP='P1  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          P1=10.0
        ELSE
          P1=VALUE(ILOCP)
          IF(P1.LT.0.0)P1=10.0
          IF(P1.GT.50.0)P1=50.0
        ENDIF
C
        IHP='P2  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          P2=10.0
        ELSE
          P2=VALUE(ILOCP)
          IF(P2.LT.0.0)P2=10.0
          IF(P2.GT.50.0)P2=50.0
        ENDIF
C
        IHP='BETA'
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1       IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1       ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          BETA=0.1
        ELSE
          BETA=VALUE(ILOCP)
          IF(BETA.LE.0.0)BETA=0.01
          IF(P2.GT.0.5)BETA=0.5
        ENDIF
C
        CALL MATARI(TEMPM1,NR1,NC1,TEMPM2,NR2,NC2,NR3,NC3,
     1  MAXROM,MAXCOM,
     1  TEMP1,NS(1),TEMP2,NS(2),TEMP3,NS(3),TEMP4,NS(4),
     1  ITEMP1,ITEMP2,ITEMP3,
     1  DTEMP1,DTEMP2,P1,P2,BETA,
     1  TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4),
     1  IMCASE,IUPFLG,IMSUBC,
     1  ITYPA(1),ITYPA(2),ITYPA(3),ITYPA(4),NUMVAR,IWRITE,
     1  TEMM91,NR91,NC91,TEMP91,NVECT9,SCAL91,ITYP91,
     1  IBUGA3,ISUBRO,IERROR)
      ENDIF
C
      NITEMX=NVECT9
      IF(IERROR.EQ.'YES')GOTO19000
      IF(ITYP91.EQ.'VECT')THEN
        DO11887I=1,NITEMX
          TEMP1(I)=TEMP91(I)
11887   CONTINUE
      ELSEIF(ITYP91.EQ.'MATR')THEN
        NITEMX=NR91
        DO11882J=1,NC91
        DO11883I=1,NITEMX
          TEMPM1((J-1)*MAXROM+I)=TEMM91((J-1)*MAXROM+I)
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')THEN
            WRITE(ICOUT,11885)I,J,TEMM91((J-1)*MAXROM+I)
11885       FORMAT('I,J,TEMPM1((J-1)*MAXROM+I) = ',2I8,E15.7)
            CALL DPWRST('XXX','BUG ')
          ENDIF
11883   CONTINUE
11882   CONTINUE
        IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF')THEN
          DO11886I=1,NVECT9
            TEMP1(I)=TEMP91(I)
11886     CONTINUE
        ENDIF
      ENDIF
      IFOUND='YES'
      IF(IERROR.EQ.'YES')GOTO19000
C
C
C               *****************************************************
C               **  STEP XX--                                      **
C               **  BRANCH TO THE PROPER CASE
C               **  DEPENDING ON THE TYPE OF OUTPUT--
C               **     1) SCALAR (= PARAMETER)
C               **     2) VECTOR (= VARIABLE) (THE USUAL)
C               **     3) MATRIX
C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE
C               **  AND HOUSEKEEPING TABLES
C               *****************************************************
C
12000 CONTINUE
      IF(ITYP91.EQ.'SCAL')GOTO14000
C
C     -----TREAT THE VECTOR AND MATRIX CASE-----
C
CCCCC NOTE: FOR "MATRIX COLUMN "
CCCCC CASE, TREAT AS FULL EVEN IF A SUBSET CLAUSE WAS ENTERED
CCCCC (NUMBER OF ROWS IN THE RETURNED VECTOR IS KEYED TO THE
CCCCC COLUMNS IN THE MATRIX, NOT THE ROWS IN THE MATRIX).
CCCCC NOTE: FURTHER CONSIDERATION SHOWED THAT WHETHER UPDATING
CCCCC SHOULD BE DONE AS "FULL" OR AS SUBSET CASE DEPENDDS ON THE
CCCCC SPECIFIC MATRIX COMMAND (E.G., MATRIX ADDITION SHOULD MAINTAIN
CCCCC THE SUBSET WHEN SAVING THE RESULT, WHILE A CORRELATION
CCCCC MATRIX SHOULD ALWAYS BE UPDATED AS A FULL MATRIX).
C
      IF(IUPFLG.EQ.'FULL' .OR. ICASEQ.EQ.'FULL')GOTO12100
      IF(ICASEQ.EQ.'SUBS')GOTO12300
      IF(ICASEQ.EQ.'FOR')GOTO12500
C
C               *******************************************
C               **  STEP 11.1--                          **
C               **  TREAT THE FULL CASE.                 **
C               *******************************************
C
12100 CONTINUE
      ISTEPN='11.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)THEN
        IROW1=0
        IROWN=0
        GOTO12190
      ENDIF
C
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12130
      IF(ICASL7.EQ.'IURN'.AND.ITYP91.EQ.'MATR')GOTO12130
      IF(ICASL7.EQ.'DIRN'.AND.ITYP91.EQ.'MATR')GOTO12130
      IF(ICASL7.EQ.'MURN'.AND.ITYP91.EQ.'MATR')GOTO12130
      IF(ICASL7.EQ.'WIRN'.AND.ITYP91.EQ.'MATR')GOTO12130
C
      DO12110I=1,NITEMX
        NSX=I
C
        IJ=MAXN*(ICOLL(1)-1)+I
        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
12110 CONTINUE
C
      IF(ICASL7.EQ.'MATB' .OR. ICASL7.EQ.'MARB')THEN
        DO12120I=1,NITEMX
          NSX=I
          IJ=MAXN*(ICOLL(2)-1)+I
          IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP2(NSX)
          IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP2(NSX)
12120   CONTINUE
      ENDIF
C
      GOTO12190
C
C     -----BEGIN MATRIX COPY FOR FULL CASE-----
C
12130 CONTINUE
      ISTEPN='FULL'
      ISTEPN='11.3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NLOOP=NC91
C
      ICOL=ICOLL(1)-1+NLOOP
      IF(ICOL.LE.MAXCOL)GOTO12139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12131)
12131 FORMAT('***** ERROR 12131 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12132)
12132 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12133)
12133 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12134)MAXCOL
12134 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12135)
12135 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
12139 CONTINUE
C
CCCCC OCTOBER 1993.  FOR MATRIX AUGMENT, NEED TO ADD NC2 BLANK 
CCCCC COLUMNS IF LEFT HAND MATRIX IS OLD.
      IF(NEWNAM(1).NE.'YES'.AND.ICASL7.EQ.'MAAU')THEN
        NFIRST=IVALU2(ILISL(1))+1
        NUMADD=NC2
        IERROR='NO'
        CALL DPUPD2(NUMADD,NFIRST,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO19000
      ENDIF
C
      ISTEPN='11.4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      DO12140JLOOP=1,NLOOP
      NSX=0
      DO12150I=1,NITEMX
      NSX=I
      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
12150 CONTINUE
12140 CONTINUE
C
CCCCC JULY 1993.  IF FIRST MATRIX IS NEW, NEED TO ADJUST COLUMN 
CCCCC             NUMBERS FOR SECOND (AND POSSIBLY THIRD) NEW VARIABLES
CCCCC             OR MATRICES ON LEFT.
      IF(NEWNAM(1).EQ.'YES')THEN
        IF(NEWNAM(2).EQ.'YES')THEN
          NADD=NLOOP-1
          ICOLL(2)=ICOLL(2)+NADD
          ILISL(2)=ILISL(2)+NADD+1
        ENDIF
        IF(NEWNAM(3).EQ.'YES')THEN
          NADD=NLOOP-1
          ICOLL(3)=ICOLL(3)+NADD
          ILISL(3)=ILISL(3)+NADD+1
        ENDIF
      ENDIF
      IF(ICASL7.EQ.'MASD')GOTO22130
      IF(ICASL7.EQ.'MASF')GOTO22130
      GOTO12190
C
CCCCC NOTE: FOR SVD, SVF, HAVE LET U S V = MATRIX SING VALUE FACT M
CCCCC       I.E., THE SECOND MATRIX IS IN THE THIRD ARGUMENT.
22130 CONTINUE
      NLOOP=NC2
C
      ICOL=ICOLL(3)-1+NLOOP
      IF(ICOL.LE.MAXCOL)GOTO22139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,22131)
22131 FORMAT('***** ERROR 22131 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,22132)
22132 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,22133)
22133 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,22134)MAXCOL
22134 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,22135)
22135 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
22139 CONTINUE
C
      DO22140JLOOP=1,NLOOP
      NSX=0
      DO22150I=1,NR2
      NSX=I
      IJ=MAXN*(ICOLL(3)-1+JLOOP-1)+I
      IF(ICOLL(3).LE.MAXCOL)V(IJ)=TEMPM2((JLOOP-1)*MAXROM+NSX)
22150 CONTINUE
22140 CONTINUE
      GOTO12190
C
C     -----END MATRIX COPY FOR FULL CASE-----
C
12190 CONTINUE
C
      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
        IF(NITEMX.GE.1)IROW1=1
        IF(NITEMX.GE.1)IROWN=NITEMX
        IN(ILISL(1))=NITEMX
        IF(NUMVAL.EQ.2)IN(ILISL(2))=NITEMX
      ELSE
        IF(NITEMX.GE.1)IROW1=1
        IF(NITEMX.GE.1)IROWN=NITEMX
        IN(ILISL(1))=NITEMX
        IF(NUMVAL.EQ.2)IN(ILISL(2))=NVECT9
        IF(NUMVAL.EQ.3)IN(ILISL(3))=NR2
      ENDIF
C
      DO12210J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12215
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12215
      GOTO12210
12215 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(1)
      VALUE(J4)=ICOLL(1)
      IN(J4)=NITEMX
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')THEN
        IVALUE(J4)=ICOLL(1)
        IVALU2(J4)=ICOLL(1)+NC91-1
      ENDIF
12210 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12229
      DO12220J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12225
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12225
      GOTO12220
12225 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(2)
      VALUE(J4)=ICOLL(2)
      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
        IN(J4)=NITEMX
      ELSE
        IN(J4)=NVECT9
      ENDIF
12220 CONTINUE
12229 CONTINUE
C
      IF(NUMVAL.LE.2)GOTO12239
      DO12230J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(3))GOTO12235
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(3))GOTO12235
      GOTO12230
12235 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(3)
      VALUE(J4)=ICOLL(3)
      IF(ICASL7.NE.'MASD'.AND.ICASL7.NE.'MASF')THEN
        IN(J4)=NITEMX
      ELSE
        IN(J4)=NR2
        IVALUE(J4)=ICOLL(3)
        IVALU2(J4)=ICOLL(3)+NC2-1
      ENDIF
12230 CONTINUE
12239 CONTINUE
C
      GOTO13000
C
C               *******************************************
C               **  STEP 11.2--                          **
C               **  TREAT THE SUBSET CASE.               **
C               *******************************************
C
12300 CONTINUE
      ISTEPN='11.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)GOTO12390
C
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12330
C
      DO12310I=1,NITEMX
        IF(ISUB(I).EQ.0)GOTO12310
        NSX=NSX+1
C
        IJ=MAXN*(ICOLL(1)-1)+I
        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
        IF(NSX.EQ.1)IROW1=I
        IROWN=I
C
12310 CONTINUE
      GOTO12390
C
C     -----BEGIN MATRIX COPY FOR SUBSET CASE-----
C
12330 CONTINUE
      NLOOP=NC91
C
      ICOL=ICOLL(1)-1+NLOOP
      IF(ICOL.LE.MAXCOL)GOTO12339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12331)
12331 FORMAT('***** ERROR 12331 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12332)
12332 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12333)
12333 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12334)MAXCOL
12334 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12335)
12335 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
12339 CONTINUE
C
      DO12340JLOOP=1,NLOOP
      NSX=0
      DO12350I=1,NITEMX
      IF(ISUB(I).EQ.0)GOTO12350
      NSX=NSX+1
      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
      IF(NSX.EQ.1)IROW1=I
      IROWN=I
12350 CONTINUE
12340 CONTINUE
      GOTO12390
C
C     -----END MATRIX COPY FOR SUBSET CASE-----
C
12390 CONTINUE
C
      IN(ILISL(1))=NITEMX
      IF(NUMVAL.EQ.2)IN(ILISL(2))=NITEMX
C
      DO12410J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12415
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12415
      GOTO12410
12415 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(1)
      VALUE(J4)=ICOLL(1)
      IN(J4)=NITEMX
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALUE(J4)=ICOLL(1)
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALU2(J4)=ICOLL(1)+NC91-1
12410 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12429
      DO12420J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12425
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12425
      GOTO12420
12425 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(2)
      VALUE(J4)=ICOLL(2)
      IN(J4)=NITEMX
12420 CONTINUE
12429 CONTINUE
C
      GOTO13000
C
C               *******************************************
C               **  STEP 11.3--                          **
C               **  TREAT THE FOR CASE.                  **
C               *******************************************
C
12500 CONTINUE
      ISTEPN='11.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NSX=0
      IF(NITEMX.LE.0)IROW1=0
      IF(NITEMX.LE.0)IROWN=0
      IF(NITEMX.LE.0)GOTO12590
C
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')GOTO12530
C
      DO12510I=1,NITEMX
        IF(I.GT.NIFOR)GOTO12590
        IF(ISUB(I).EQ.0)GOTO12510
        NSX=NSX+1
        IJ=MAXN*(ICOLL(1)-1)+I
        IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP1)PRED(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP2)RES(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP3)YPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP4)XPLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP5)X2PLOT(I)=TEMP1(NSX)
        IF(ICOLL(1).EQ.MAXCP6)TAGPLO(I)=TEMP1(NSX)
        IF(NSX.EQ.1)IROW1=I
        IROWN=I
C
12510 CONTINUE
      GOTO12590
C
C     -----BEGIN MATRIX COPY FOR   FOR    CASE-----
C
12530 CONTINUE
      NLOOP=NC91
C
      ICOL=ICOLL(1)-1+NLOOP
      IF(ICOL.LE.MAXCOL)GOTO12539
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12531)
12531 FORMAT('***** ERROR 12531 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12532)
12532 FORMAT('      AN ATTEMPT WAS MADE TO CREATE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12533)
12533 FORMAT('      A MATRIX WHOSE COLUMNS EXTEND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12534)MAXCOL
12534 FORMAT('      BEYOND THE ALLOWABLE ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12535)
12535 FORMAT('      OF THE INTERNAL INTERNAL WORKSHEET.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
12539 CONTINUE
C
      DO12540JLOOP=1,NLOOP
      NSX=0
      DO12550I=1,NITEMX
      IF(I.GT.NIFOR)GOTO12550
      IF(ISUB(I).EQ.0)GOTO12550
      NSX=NSX+1
      IJ=MAXN*(ICOLL(1)-1+JLOOP-1)+I
      IF(ICOLL(1).LE.MAXCOL)V(IJ)=TEMPM1((JLOOP-1)*MAXROM+NSX)
      IF(NSX.EQ.1)IROW1=I
      IROWN=I
12550 CONTINUE
12540 CONTINUE
      GOTO12590
C
C     -----END MATRIX COPY FOR   FOR    CASE-----
C
12590 CONTINUE
C
      IN(ILISL(1))=NITEMX
      IF(NUMVAL.EQ.2)IN(ILISL(2))=NITEMX
C
      DO12610J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12615
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(1))GOTO12615
      GOTO12610
12615 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(1)
      VALUE(J4)=ICOLL(1)
      IN(J4)=NITEMX
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALUE(J4)=ICOLL(1)
      IF(IMATSW.EQ.'YES'.AND.ITYP91.EQ.'MATR')IVALU2(J4)=ICOLL(1)+NC91-1
12610 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO12629
      DO12620J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12625
      IF(IUSE(J4).EQ.'M'.AND.IVALUE(J4).EQ.ICOLL(2))GOTO12625
      GOTO12620
12625 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL(2)
      VALUE(J4)=ICOLL(2)
      IN(J4)=NITEMX
12620 CONTINUE
12629 CONTINUE
C
      GOTO13000
C
C               *****************************************************
C               **  STEP 13--                                      **
C               **  BRANCH TO THE PROPER CASE
C               **  DEPENDING ON THE TYPE OF OUTPUT--
C               **     1) SCALAR (= PARAMETER)
C               **     2) VECTOR (= VARIABLE) (THE USUAL)
C               **     3) MATRIX
C               **  UPDATE DATAPLOT'S INTERNAL WORKSPACE
C               **  AND HOUSEKEEPING TABLES
C               *****************************************************
C
13000 CONTINUE
      IF(ITYP91.EQ.'SCAL')GOTO14000
      IF(ITYP91.EQ.'MATR')GOTO15000
      GOTO16000
C
C               *****************************************************
C               **  STEP 14--                                      **
C               **  TREAT THE PARAMETER (SCALAR) CASE.             **
C               **  EXAMPLE--LET D = DETERMINANT A                 **
C               **           WHERE A WAS PREVIOUSLY UNDEFINED      **
C               **           OR WHERE A WAS PREVIOUSLY A PARAMETER.**
C               **  CARRY OUT THE LIST UPDATING  AND               **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
14000 CONTINUE
      ISTEPN='14'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISL(1))=ILEFT(1)
      IHNAM2(ILISL(1))=ILEF2(1)
      IUSE(ILISL(1))='P'
      VALUE(ILISL(1))=SCAL91
      IVALUE(ILISL(1))=VALUE(ILISL(1))+0.5
      IN(ILISL(1))=1
      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
C
      IF(IPRINT.EQ.'OFF')GOTO14019
      IF(IFEEDB.EQ.'OFF')GOTO14019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14011)ILEFT(1),ILEF2(1),SCAL91
14011 FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
     1A4,A4,'      = ',E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
14019 CONTINUE
C
C  FOR MULTIVARIATE NORMAL CDF OR MULTIVARIATE T CDF, UPDATE
C  AN ADDITIONAL PARAMETER.  SET IT AFTER OTHER SCALAR UPDATE
C  TO AVOID OVERWRITE.
C
      IF(ICASL7.EQ.'NCDF'.OR.ICASL7.EQ.'TCDF')THEN
        IHP='NCDF'
        IHP2='ERRS'
        VALUE0=ERRS
        CALL DPADDP(IHP,IHP2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
      ENDIF
      GOTO19000
C
C               *******************************************
C               **  STEP 15--                            **
C               **  TREAT THE MATRIX CASE--              **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
15000 CONTINUE
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHMAT1=ILEFT(1)
      IHMAT2=ILEF2(1)
      IMATNR=NR91
      IMATNC=NC91
      IMATCO=ICOLL(1)
C
      IHNAME(ILISL(1))=IHMAT1
      IHNAM2(ILISL(1))=IHMAT2
      IUSE(ILISL(1))='M'
      IVALUE(ILISL(1))=IMATCO
      IN(ILISL(1))=IMATNR
      IVALU2(ILISL(1))=IMATCO+IMATNC-1
      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
CCCCC AUGUST 1993.  NUMBER OF COLUMNS UPDATED IN SUBSEQUENT LOOP
CCCCC IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
C
      IF(IMATNC.LE.0)GOTO15039
      INAM=NUMNAM
      DO15010J=1,IMATNC
C
      INAM=INAM+1
      IF(INAM.LE.MAXNAM)GOTO15019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15011)
15011 FORMAT('***** ERROR 15011 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15012)
15012 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15013)MAXNAM
15013 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
15019 CONTINUE
C
      ICOL=IMATCO+J-1
      IF(ICOL.LE.MAXCOL)GOTO15029
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15021)
15021 FORMAT('***** ERROR 15021 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15022)
15022 FORMAT('      THE NUMBER OF WORKSHEET VARIABLES (COLUMNS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15023)MAXCOL
15023 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
15029 CONTINUE
C
      CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IH1,IH2,IBUGA3,ISUBRO,IERROR)
      IHNAME(INAM)=IH1
      IHNAM2(INAM)=IH2
      IUSE(INAM)='V'
      IVALUE(INAM)=ICOL
      IN(INAM)=IMATNR
      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
C
15010 CONTINUE
15039 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO15090
      IF(IFEEDB.EQ.'OFF')GOTO15090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,15041)IHMAT1,IHMAT2,IMATNR
15041 FORMAT('THE NUMBER OF ROWS    GENERATED FOR ',
     1'THE MATRIX   ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,15042)IHMAT1,IHMAT2,IMATNC
15042 FORMAT('THE NUMBER OF COLUMNS GENERATED FOR ',
     1'THE MATRIX   ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,15051)IHMAT1,IHMAT2
15051 FORMAT('THE FIRST           COMPUTED ROW   OF ',A4,A4,' =')
      CALL DPWRST('XXX','BUG ')
      JMAX=IMATNC
      IF(JMAX.GT.10)JMAX=10
      DO15055J=1,JMAX
      IJ=MAXN*(IMATCO-1+J-1)+1
      TEMPV(J)=V(IJ)
15055 CONTINUE
      IF(JMAX.LE.10)WRITE(ICOUT,15056)(TEMPV(J),J=1,JMAX)
15056 FORMAT(10E10.3)
      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
      IF(JMAX.GT.10)WRITE(ICOUT,15057)(TEMPV(J),J=1,JMAX)
15057 FORMAT(10E10.3,' ...')
      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,15061)IMATNR,IHMAT1,IHMAT2
15061 FORMAT('THE LAST (',I5,'-TH) COMPUTED ROW   OF ',A4,A4,' =')
      CALL DPWRST('XXX','BUG ')
      JMAX=IMATNC
      IF(JMAX.GT.10)JMAX=10
      DO15065J=1,JMAX
      IJ=MAXN*(IMATCO-1+J-1)+IMATNR
      TEMPV(J)=V(IJ)
15065 CONTINUE
      IF(JMAX.LE.10)WRITE(ICOUT,15066)(TEMPV(J),J=1,JMAX)
15066 FORMAT(10E10.3)
      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
      IF(JMAX.GT.10)WRITE(ICOUT,15067)(TEMPV(J),J=1,JMAX)
15067 FORMAT(10E10.3,' ...')
      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
C
      IF(IMATNR.NE.1.AND.IMATNC.NE.1)GOTO15079
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15072)
15072 FORMAT('CAUTION--THIS MATRIX HAS ONLY 1 ROW AND 1 COLUMN')
      CALL DPWRST('XXX','BUG ')
15079 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IHCV11='    '
      IHCV12='    '
      IHCV21='    '
      IHCV22='    '
      IHCV31='    '
      IHCV32='    '
      J=1
      IF(IMATNC.GE.1)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV11,IHCV12,IBUGA3,ISUBRO,IERROR)
      J=2
      IF(IMATNC.GE.2)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV21,IHCV22,IBUGA3,ISUBRO,IERROR)
      J=3
      IF(IMATNC.GE.3)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV31,IHCV32,IBUGA3,ISUBRO,IERROR)
      IF(IMATNC.LE.3)
     1WRITE(ICOUT,15081)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
     1IHCV31,IHCV32
15081 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4)
      IF(IMATNC.LE.3)
     1CALL DPWRST('XXX','BUG ')
      IF(IMATNC.GT.3)
     1WRITE(ICOUT,15082)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
     1IHCV31,IHCV32
15082 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4,' ...')
      IF(IMATNC.GT.3)
     1CALL DPWRST('XXX','BUG ')
C
      ICV1=IMATCO
      ICV2=IMATCO+IMATNC-1
      WRITE(ICOUT,15083)IHMAT1,IHMAT2,ICV1,ICV2
15083 FORMAT('THE WORKSHEET COLUMNS   ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',I8,' TO',I8)
      CALL DPWRST('XXX','BUG ')
C
15090 CONTINUE
      IF(ICASL7.EQ.'MASD' .OR. ICASL7.EQ.'MASF')GOTO25000
C
      GOTO19000
C
C               *******************************************
C               **  STEP 25--                            **
C               **  TREAT THE MATRIX CASE--              **
C               **  UPDATE MATRIX 2                      **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
25000 CONTINUE
      ISTEPN='25'
CCCCC JULY 1993.  SINGULAR VALUE DECOMPOSTION USES VECTOR AS SECOND
CCCCC ARGUMENT ON LEFT.
      IHNAME(ILISL(2))=ILEFT(2)
      IHNAM2(ILISL(2))=ILEF2(2)
      IUSE(ILISL(2))='V'
      IVALUE(ILISL(2))=ICOLL(2)
      VALUE(ILISL(2))=ICOLL(2)
      IN(ILISL(2))=NVECT9
      IF(NEWNAM(2).EQ.'YES')NUMNAM=NUMNAM+1
CCCCC AUGUST 1993.  NUMBER OF COLUMNS UPDATED IN SUBSEQUENT LOOP
CCCCC IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
      IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
C
      DO25002I=1,NVECT9
      IJ=MAXN*(ICOLL(2)-1)+I
      IF(ICOLL(2).LE.MAXCOL)V(IJ)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP1)PRED(I)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP2)RES(I)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP3)YPLOT(I)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP4)XPLOT(I)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP5)X2PLOT(I)=TEMP1(I)
      IF(ICOLL(2).EQ.MAXCP6)TAGPLO(I)=TEMP1(I)
25002 CONTINUE
C
      ISTEPN='25A'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHMAT1=ILEFT(3)
      IHMAT2=ILEF2(3)
      IMATNR=NR2
      IMATNC=NC2
      IMATCO=ICOLL(3)
C
      IHNAME(ILISL(3))=IHMAT1
      IHNAM2(ILISL(3))=IHMAT2
      IUSE(ILISL(3))='M'
      IVALUE(ILISL(3))=IMATCO
      IN(ILISL(3))=IMATNR
      IVALU2(ILISL(3))=IMATCO+IMATNC-1
      IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM(3).EQ.'YES')NUMCOL=NUMCOL+1
C
      IF(IMATNC.LE.0)GOTO25039
      INAM=NUMNAM
      DO25010J=1,IMATNC
C
      INAM=INAM+1
      IF(INAM.LE.MAXNAM)GOTO25019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25011)
25011 FORMAT('***** ERROR 15011 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25012)
25012 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25013)MAXNAM
25013 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
25019 CONTINUE
C
      ICOL=IMATCO+J-1
      IF(INAM.LE.MAXNAM)GOTO25029
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25021)
25021 FORMAT('***** ERROR 25021 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25022)
25022 FORMAT('      THE NUMBER OF WORKSHEET VARIABLES (COLUMNS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25023)MAXCOL
25023 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
25029 CONTINUE
C
      CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IH1,IH2,IBUGA3,ISUBRO,IERROR)
      IHNAME(INAM)=IH1
      IHNAM2(INAM)=IH2
      IUSE(INAM)='V'
      IVALUE(INAM)=ICOL
      IN(INAM)=IMATNR
      IF(NEWNAM(3).EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM(3).EQ.'YES')NUMCOL=NUMCOL+1
C
25010 CONTINUE
25039 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO25090
      IF(IFEEDB.EQ.'OFF')GOTO25090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,25041)IHMAT1,IHMAT2,IMATNR
25041 FORMAT('THE NUMBER OF ROWS    GENERATED FOR ',
     1'THE MATRIX   ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,25042)IHMAT1,IHMAT2,IMATNC
25042 FORMAT('THE NUMBER OF COLUMNS GENERATED FOR ',
     1'THE MATRIX   ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,25051)IHMAT1,IHMAT2
25051 FORMAT('THE FIRST           COMPUTED ROW   OF ',A4,A4,' =')
      CALL DPWRST('XXX','BUG ')
      JMAX=IMATNC
      IF(JMAX.GT.10)JMAX=10
      DO25055J=1,JMAX
      IJ=MAXN*(IMATCO-1+J-1)+1
      TEMPV(J)=V(IJ)
25055 CONTINUE
      IF(JMAX.LE.10)WRITE(ICOUT,25056)(TEMPV(J),J=1,JMAX)
25056 FORMAT(10E10.3)
      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
      IF(JMAX.GT.10)WRITE(ICOUT,25057)(TEMPV(J),J=1,JMAX)
25057 FORMAT(10E10.3,' ...')
      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,25061)IMATNR,IHMAT1,IHMAT2
25061 FORMAT('THE LAST (',I5,'-TH) COMPUTED ROW   OF ',A4,A4,' =')
      CALL DPWRST('XXX','BUG ')
      JMAX=IMATNC
      IF(JMAX.GT.10)JMAX=10
      DO25065J=1,JMAX
      IJ=MAXN*(IMATCO-1+J-1)+IMATNR
      TEMPV(J)=V(IJ)
25065 CONTINUE
      IF(JMAX.LE.10)WRITE(ICOUT,25066)(TEMPV(J),J=1,JMAX)
25066 FORMAT(10E10.3)
      IF(JMAX.LE.10)CALL DPWRST('XXX','BUG ')
      IF(JMAX.GT.10)WRITE(ICOUT,25067)(TEMPV(J),J=1,JMAX)
25067 FORMAT(10E10.3,' ...')
      IF(JMAX.GT.10)CALL DPWRST('XXX','BUG ')
C
      IF(IMATNR.NE.1.AND.IMATNC.NE.1)GOTO25079
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,25072)
25072 FORMAT('CAUTION--THIS MATRIX HAS ONLY 1 ROW AND 1 COLUMN')
      CALL DPWRST('XXX','BUG ')
25079 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IHCV11='    '
      IHCV12='    '
      IHCV21='    '
      IHCV22='    '
      IHCV31='    '
      IHCV32='    '
      J=1
      IF(IMATNC.GE.1)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV11,IHCV12,IBUGA3,ISUBRO,IERROR)
      J=2
      IF(IMATNC.GE.2)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV21,IHCV22,IBUGA3,ISUBRO,IERROR)
      J=3
      IF(IMATNC.GE.3)CALL DPAPN2(IHMAT1,IHMAT2,J,
     1IHCV31,IHCV32,IBUGA3,ISUBRO,IERROR)
      IF(IMATNC.LE.3)
     1WRITE(ICOUT,25081)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
     1IHCV31,IHCV32
25081 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4)
      IF(IMATNC.LE.3)
     1CALL DPWRST('XXX','BUG ')
      IF(IMATNC.GT.3)
     1WRITE(ICOUT,25082)IHMAT1,IHMAT2,IHCV11,IHCV12,IHCV21,IHCV22,
     1IHCV31,IHCV32
25082 FORMAT('THE COLUMN VECTOR NAMES ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',A4,A4,2X,A4,A4,2X,A4,A4,' ...')
      IF(IMATNC.GT.3)
     1CALL DPWRST('XXX','BUG ')
C
      ICV1=IMATCO
      ICV2=IMATCO+IMATNC-1
      WRITE(ICOUT,25083)IHMAT1,IHMAT2,ICV1,ICV2
25083 FORMAT('THE WORKSHEET COLUMNS   ASSIGNED TO MATRIX ',A4,A4,
     1'ARE ',I8,' TO',I8)
      CALL DPWRST('XXX','BUG ')
C
25090 CONTINUE
C
      GOTO19000
C
C
C               *******************************************
C               **  STEP 16--                            **
C               **  TREAT THE VARIABLE (VECTOR) CASE--   **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
16000 CONTINUE
      ISTEPN='16'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISL(1))=ILEFT(1)
      IHNAM2(ILISL(1))=ILEF2(1)
      IUSE(ILISL(1))='V'
      IVALUE(ILISL(1))=ICOLL(1)
      VALUE(ILISL(1))=ICOLL(1)
      IF(NEWNAM(1).EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM(1).EQ.'YES')NUMCOL=NUMCOL+1
C
      IF(NUMVAL.LE.1)GOTO16009
      IHNAME(ILISL(2))=ILEFT(2)
      IHNAM2(ILISL(2))=ILEF2(2)
      IUSE(ILISL(2))='V'
      IVALUE(ILISL(2))=ICOLL(2)
      VALUE(ILISL(2))=ICOLL(2)
      IF(NEWNAM(2).EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM(2).EQ.'YES')NUMCOL=NUMCOL+1
16009 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO16090
      IF(IFEEDB.EQ.'OFF')GOTO16090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,16011)ILEFT(1),ILEF2(1),NSX
16011 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL(1)-1)+IROW1
      IF(ICOLL(1).LE.MAXCOL)THEN
         WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),V(IJ),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP1)THEN
         WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),PRED(IROW1),IROW1
16021    FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1          ' = ',E16.7,'   (ROW ',I6,')')
         CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP2)THEN
        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),RES(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP3)THEN
        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),YPLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP4)THEN
        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),XPLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP5)THEN
        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),X2PLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP6)THEN
        WRITE(ICOUT,16021)ILEFT(1),ILEF2(1),TAGPLO(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL(1)-1)+IROWN
16031 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E16.7,'   (ROW ',I6,')')
      IF(ICOLL(1).LE.MAXCOL.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),V(IJ),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP1.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),PRED(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP2.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),RES(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP3.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),YPLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP4.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),XPLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP5.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),X2PLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(1).EQ.MAXCP6.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16031)NSX,ILEFT(1),ILEF2(1),TAGPLO(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NSX.NE.1)GOTO16039
      WRITE(ICOUT,16032)
16032 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16033)
16033 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
16039 CONTINUE
C
      IF(NUMVAL.LE.1)GOTO16079
      WRITE(ICOUT,16051)ILEFT(2),ILEF2(2),NSX
16051 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL(2)-1)+IROW1
16061 FORMAT('THE FIRST           COMPUTED VALUE OF ',A4,A4,
     1' = ',E16.7,'   (ROW ',I6,')')
      IF(ICOLL(2).LE.MAXCOL)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),V(IJ),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP1)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),PRED(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP2)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),RES(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP3)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),YPLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP4)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),XPLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP5)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),X2PLOT(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP6)THEN
        WRITE(ICOUT,16061)ILEFT(2),ILEF2(2),TAGPLO(IROW1),IROW1
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL(2)-1)+IROWN
16071 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E16.7,'   (ROW ',I6,')')
      IF(ICOLL(2).LE.MAXCOL.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),V(IJ),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP1.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),PRED(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP2.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),RES(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP3.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),YPLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP4.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),XPLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP5.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(2),X2PLOT(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ICOLL(2).EQ.MAXCP6.AND.NSX.NE.1)THEN
        WRITE(ICOUT,16071)NSX,ILEFT(2),ILEF2(1),TAGPLO(IROWN),IROWN
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(NSX.NE.1)GOTO16079
      WRITE(ICOUT,16072)
16072 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16073)
16073 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
16079 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
16090 CONTINUE
      GOTO19000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO19090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19011)
19011 FORMAT('***** AT THE END       OF DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19012)IFOUND,IERROR
19012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19013)IBUGA3,IBUGQ,ISUBRO
19013 FORMAT('IBUGA3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19014)ICASL7,ILOCV,ITCASE,IWRITE
19014 FORMAT('ICASL7,ILOCV,ITCASE,IWRITE = ',A4,2X,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19016)NSX,NITEMX,NS(1),NS(2)
19016 FORMAT('NSX,NITEMX,NS(1),NS(2) = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19021)ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1)
19021 FORMAT('ILEFT(1),ILEF2(1),ILISL(1),ICOLL(1) = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19022)ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2)
19022 FORMAT('ILEFT(2),ILEF2(2),ILISL(2),ICOLL(2) = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19023)NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR
19023 FORMAT('NUMVAL,NEWNAM(1),NEWNAM(2),NUMVAR = ',I8,2X,A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO19025I=1,4
      WRITE(ICOUT,19024)I,ILISR(I),ICOLR(I),ITYPA(I)
19024 FORMAT('I,ILISR(I),ICOLR(I),ITYPA(I) = ',I2,I8,I8,1X,A4)
      CALL DPWRST('XXX','BUG ')
19025 CONTINUE
      WRITE(ICOUT,19026)TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4)
19026 FORMAT('TEMPS(1),TEMPS(2),TEMPS(3),TEMPS(4) = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19031)IMATSW,NUMVAR
19031 FORMAT('IMATSW,NUMVAR = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      IF(IMATSW.EQ.'NO')GOTO19079
      WRITE(ICOUT,19032)NR1,NC1,NR2,NC2,NR91,NC91
19032 FORMAT('NR1,NC1,NR2,NC2,NR91,NC91 = ',6I8)
      CALL DPWRST('XXX','BUG ')
      IF(ITYPA(1).EQ.'MATR'.OR.ITYPA(1).EQ.'VARI')THEN
        WRITE(ICOUT,19033)ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),
     1                    IVALU2(ILISR(1))
19033 FORMAT(
     1'ILISR(1),IN(ILISR(1)),IVALUE(ILISR(1)),IVALU2(ILISR(1)) = ',4I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,19034)(ILOCR(J),J=3,7)
19034 FORMAT('ILOCR(3),...,ILOCR(7) = ',5I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0 .OR. NC1.LE.0)GOTO19049
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO19045I=1,NR1
      WRITE(ICOUT,19046)I,(TEMPM1((J-1)*MAXROM+I),J=1,JMAX)
19046 FORMAT('I,TEMPM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
19045 CONTINUE
19049 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0 .OR. NC2.LE.0)GOTO19059
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO19055I=1,NR2
      WRITE(ICOUT,19056)I,(TEMPM2((J-1)*MAXROM+I),J=1,JMAX)
19056 FORMAT('I,TEMPM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
19055 CONTINUE
19059 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NR91.LE.0 .OR. NC91.LE.0)GOTO19069
      JMAX=NC91
      IF(JMAX.GT.10)JMAX=10
      DO19065I=1,NR91
      WRITE(ICOUT,19066)I,(TEMM91((J-1)*MAXROM+I),J=1,JMAX)
19066 FORMAT('I,TEMM91(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
19065 CONTINUE
19069 CONTINUE
19079 CONTINUE
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMAT6(ICASL7,ICASE,MAXCAS,
     1ILEFT,ILEFT2,NEWNAM,ILISL,ICOLL,
     1NUMVAL,NIOLD,
     1IBUGA3,ISUBRO,IFOUND,IERROR)
C
C     NOTE--THIS SUBROUTINE IS A UTILITY ROUTINE FOR DPMATC AND
C           DPMAT2.  IT CHECKS A VARIABLE ON THE LEFT HAND SIDE
C           OF THE EQUAL SIGN.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/6
C     ORIGINAL VERSION--JUNE      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASL7
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM(MAXCAS)
      CHARACTER*4 ILEFT(MAXCAS)
      CHARACTER*4 ILEFT2(MAXCAS)
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      INTEGER ILISL(MAXCAS)
      INTEGER ICOLL(MAXCAS)
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='T6  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAT6--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICASL7,IBUGA3,ISUBRO
   52   FORMAT('ICASL7,IBUGA3,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM(ICASE)='NO'
C
C               ******************************************************
C               **  STEP 2A--                                        *
C               **  EXAMINE THE LEFT-HAND SIDE--                     *
C               **  IS THE VARIABLE NAME TO LEFT OF = SIGN           *
C               **  ALREADY IN THE NAME LIST?    AS A VARIABLE?      *
C               **  NOTE THAT  ILEFT   IS THE NAME OF THE VARIABLE   *
C               **  ON THE LEFT.                                     *
C               **  NOTE THAT     ILISL     IS THE LINE IN THE TABLE *
C               **  OF THE NAME ON THE LEFT.                         *
C               **  NOTE THAT  ICOLL(ICASE)  IS THE DATA COLUMN      *
C               **  (1 TO 12)                                        *
C               **  FOR THE NAME OF THE LEFT.                        *
C               ******************************************************
C
      ISTEPN='2A'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILEFT(ICASE)=IHARG(ICASE)
      ILEFT2(ICASE)=IHARG2(ICASE)
      DO210I=1,NUMNAM
        I2=I
        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
     1     ILEFT2(ICASE).EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')GOTO230
        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
     1    ILEFT2(ICASE).EQ.IHNAM2(I).AND.
     1    IUSE(I).EQ.'V')GOTO280
        IF(ILEFT(ICASE).EQ.IHNAME(I).AND.
     1     ILEFT2(ICASE).EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')GOTO280
  210 CONTINUE
C
C  CASE WHERE NAME NOT FOUND IN CURRENT NAME LIST
C
      NEWNAM(ICASE)='YES'
      IF(ICASE.GT.1)NUMVAL=ICASE
C
      IJUNK=0
      DO211I=1,ICASE
        IF(NEWNAM(I).EQ.'YES')IJUNK=IJUNK+1
  211 CONTINUE
      ILISL(ICASE)=NUMNAM+IJUNK
C
      IF(ILISL(ICASE).GT.MAXNAM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,221)
  221   FORMAT('***** ERROR 221 IN DPMAT6--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,222)
  222   FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,223)MAXNAM
  223   FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1         I8,'  .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,224)
  224   FORMAT('      SUGGESTED ACTION--ENTER    STATUS VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,226)
  226   FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,227)
  227   FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,228)
  228   FORMAT('      ALREADY-USED NAMES.  ALTERNATIVELY, USE THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,229)
  229   FORMAT('      DELETE COMMAND TO FREE NO LONGER NEED NAMES.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO19000
      ELSE
        GOTO235
      ENDIF
C
C  CASE WHERE NAME FOUND AS A PARAMETER
C
  230 CONTINUE
      IF(ICASE.GT.1)NUMVAL=ICASE
      ILISL(ICASE)=I2
      GOTO235
C
  235 CONTINUE
      NIOLD=0
      IF(ICASE.GT.1)NUMVAL=ICASE
      IF(ICASE.EQ.1)THEN
        ICOLL(ICASE)=NUMCOL+1
      ELSEIF(ICASE.GT.1)THEN
        ICOLL(ICASE)=NUMCOL
        DO237I=1,ICASE
          IF(NEWNAM(I).EQ.'YES')ICOLL(ICASE)=ICOLL(ICASE)+1
  237   CONTINUE
      ENDIF
      IF(ICOLL(ICASE).LE.MAXCOL)GOTO290
C
      WRITE(ICOUT,241)
  241 FORMAT('***** ERROR 241 IN DPMAT6--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)
  242 FORMAT('      THE NUMBER OF DATA COLUMNS HAS JUST EXCEEDED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)MAXCOL
  243 FORMAT('      THE MAX ALLOWABLE ',I8,'  .  SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,245)
  245 FORMAT('      ENTER      STATUS VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,246)
  246 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,247)
  247 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,248)
  248 FORMAT('      IF       LET X(I) = 3.14         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,249)
  249 FORMAT('      THEN ONE MIGHT ENTER     LET X = COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,250)
  250 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,251)
  251 FORMAT('      FOLLOWED BY              LET X(I) = 3.14')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,252)
  252 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,253)
  253 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,255)
  255 FORMAT('      ALTERNATIVELY, USE THE DIMENSION COMMAND TO ',
     1       'CREATE MORE COLUMNS.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
C  CASE WHERE NAME FOUND AS A VARIABLE
C
  280 CONTINUE
      IF(ICASE.GT.1)NUMVAL=ICASE
      ILISL(ICASE)=I2
      ICOLL(ICASE)=IVALUE(ILISL(ICASE))
      NIOLD=IN(ILISL(ICASE))
C
  290 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
        WRITE(ICOUT,291)
  291   FORMAT('AT THE END OF STEP 2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,292)ILEFT(ICASE),ILEFT2(ICASE),NEWNAM(ICASE),
     1                  NUMNAM,ILISL(ICASE),
     1                  ICOLL(ICASE),NIOLD
        CALL DPWRST('XXX','BUG ')
  292   FORMAT('ILEFT,ILEFT2,NEWNAM,NUMNAM,ILISL(ICASE),',
     1         'ICOLL(ICASE),NIOLD = ',A4,A4,2X,A4,2X,4I8)
      ENDIF

C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT6')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19011)
19011   FORMAT('***** AT THE END       OF DPMAT6--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19012)IFOUND,IERROR
19012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19013)IBUGA3,ISUBRO
19013   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19021)ILEFT(ICASE),ILEFT2(ICASE),ILISL(ICASE),
     1                    ICOLL(ICASE)
19021   FORMAT('ILEFT,ILEFT2,ILISL(ICASE),ICOLL(ICASE) = ',
     1         A4,2X,A4,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19023)NEWNAM(ICASE)
19023   FORMAT('NEWNAM = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMAT7(ICASL7,ICASE,MAXCAS,ILOCR,
     1IHRIGH,IHRIG2,ICOLR,ILISR,NIRIGH,ITYPA,TEMPS,
     1IFLAG1,ATEMP,ITEMP,
     1IBUGA3,ISUBRO,IFOUND,IERROR)
C
C     NOTE--THIS SUBROUTINE IS A UTILITY ROUTINE FOR DPMATC AND
C           DPMAT2.  IT CHECKS A VARIABLE ON THE LEFT HAND SIDE
C           OF THE EQUAL SIGN.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2002/6
C     ORIGINAL VERSION--JUNE      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASL7
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 ITYPA(MAXCAS)
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      REAL TEMPS(MAXCAS)
C
      INTEGER ICOLR(MAXCAS)
      INTEGER ILISR(MAXCAS)
      INTEGER NIRIGH(MAXCAS)
      INTEGER ILOCR(MAXCAS)
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMA'
      ISUBN2='T7  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPMAT7--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICASL7,IBUGA3,ISUBRO
   52   FORMAT('ICASL7,IBUGA3,ISUBRO = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASE
   53   FORMAT('ICASE = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)ILOCR(ICASE)
   54   FORMAT('ILOCR(ICASE) = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)ICOLR(ICASE)
   55   FORMAT('ICOLR(ICASE) = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)ILISR(ICASE)
   56   FORMAT('ILISR(ICASE) = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************************
C               **  STEP 1--                         **
C               **  EXAMINE THE VARIABLE             **
C               **  ON THE RIGHT.                    **
C               ***************************************
C
      ISTEPN='1.0'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHRIGH=IHARG(ILOCR(ICASE))
      IHRIG2=IHARG2(ILOCR(ICASE))
      ATEMP=ARG(ILOCR(ICASE))
      ITEMP=IARG(ILOCR(ICASE))
      DO1220I=1,NUMNAM
        I2=I
        IF(IHRIGH.EQ.IHNAME(I).AND.
     1     IHRIG2.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'V')GOTO1270
        IF(IHRIGH.EQ.IHNAME(I).AND.
     1     IHRIG2.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')GOTO1280
        IF(IHRIGH.EQ.IHNAME(I).AND.
     1     IHRIG2.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')GOTO1240
 1220 CONTINUE
C
      IF(IFLAG1.EQ.1)GOTO1250
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** ERROR 1221 IN DPMAT7--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1222)ICASE
 1222 FORMAT('      THE SPECIFIED ARGUMENT ',I3)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1223)
 1223 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1224)
 1224 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)
 1226 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1227)IHRIGH,IHRIG2
 1227 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1228)
 1228 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1229)(IANS(I),I=1,MIN(100,IWIDTH))
 1229   FORMAT(100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO19000
C
 1240 CONTINUE
      IF(IFLAG1.EQ.1)GOTO1260
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1241)
 1241 FORMAT('***** ERROR 1241 IN DPMAT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1242)ICASE
 1242 FORMAT('      THE SPECIFIED ARGUMENT ',I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1243)
 1243 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1244)
 1244 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1245)
 1245 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1246)
 1246 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1247)
 1247 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1248)
 1248 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1249)(IANS(I),I=1,MIN(100,IWIDTH))
 1249 FORMAT(100A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1250 CONTINUE
      ITYPA(ICASE)='PARA'
      TEMPS(ICASE)=ARG(ILOCR(ICASE))
      NIRIGH(ICASE)=1
      GOTO1290
C
 1260 CONTINUE
      ITYPA(ICASE)='PARA'
      ILISR(ICASE)=I2
      TEMPS(ICASE)=VALUE(ILISR(ICASE))
      NIRIGH(ICASE)=1
      GOTO1290
C
 1270 CONTINUE
      ITYPA(ICASE)='VARI'
      ILISR(ICASE)=I2
      ICOLR(ICASE)=IVALUE(ILISR(ICASE))
      NIRIGH(ICASE)=IN(ILISR(ICASE))
      GOTO1290
C
 1280 CONTINUE
      ITYPA(ICASE)='MATR'
      ILISR(ICASE)=I2
      ICOLR(ICASE)=IVALUE(ILISR(ICASE))
      NIRIGH(ICASE)=IN(ILISR(ICASE))
      GOTO1290
C
 1290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MAT7')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19011)
19011   FORMAT('***** AT THE END       OF DPMAT7--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19012)IFOUND,IERROR
19012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19013)IBUGA3,ISUBRO
19013   FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19021)IHRIGH,IHRIG2,
     1                    ILISR(ICASE),NIRIGH(ICASE)
19021   FORMAT('IHRIGH,IHRIG2,ILISR(ICASE),',
     1         'NIRIGH(ICASE) = ',A4,2X,A4,2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19023)ITYPA(ICASE),ICOLR(ICASE)
19023   FORMAT('ITYPA(ICASE),ICOLR(ICASE) = ',A4,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,19025)TEMPS(ICASE),NIRIGH(ICASE)
19025   FORMAT('TEMPS(ICASE),NIRIGH(ICASE) = ',E15.7,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMATH(ICHARC,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR MATH SYMBOLS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHARC
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MATH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMATH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHARC
   52 FORMAT('ICHARC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IFOUND,IERROR
   59 FORMAT('IBUGG4,ISUBG4,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHMA(ICHARC,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.32)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DMATH1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(33.LE.ICHARN.AND.ICHARN.LE.51)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DMATH2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(52.LE.ICHARN.AND.ICHARN.LE.60)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DMATH3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.61)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DMATH4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1049 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'MATH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMATH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IFOUND,IERROR
 9012 FORMAT('IBUGG4,ISUBG4,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHARC,ICHARN
 9013 FORMAT('ICHARC,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMATN(ICOM,IHARG,IARGT,IARG,NUMARG,
     1IX1JSW,IX2JSW,IY1JSW,IY2JSW,
     1NMJX1T,NMJX2T,NMJY1T,NMJY2T,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NUMBER OF MAJOR TIC MARKS
C              FOR HORIZONTAL FRAME LINES OR VERTICAL FRAME LINES OR BOTH.
C     INPUT  ARGUMENTS--ICOM  (A  CHARACTER VECTOR)
C                     --IHARG  (A  CHARACTER VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1JSW (A CHARACTER VARIABLE)
C                     --IX2JSW (A CHARACTER VARIABLE)
C                     --IY1JSW (A CHARACTER VARIABLE)
C                     --IY2JSW (A CHARACTER VARIABLE)
C                     --NMJX1T (AN INTEGER VARIABLE)
C                     --NMJX2T (AN INTEGER VARIABLE)
C                     --NMJY1T (AN INTEGER VARIABLE)
C                     --NMJY2T (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1982.
C     UPDATED--JANUARY  1988. (OPTIONAL OMISSION OF THE WORD   MAJOR)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1JSW
      CHARACTER*4 IX2JSW
      CHARACTER*4 IY1JSW
      CHARACTER*4 IY2JSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(ICOM.NE.'MAJO')GOTO1010
      GOTO1019
 1010 CONTINUE
      IF(ICOM.EQ.'XTIC')GOTO1100
      IF(ICOM.EQ.'X1TI')GOTO1200
      IF(ICOM.EQ.'X2TI')GOTO1300
      IF(ICOM.EQ.'YTIC')GOTO1400
      IF(ICOM.EQ.'Y1TI')GOTO1500
      IF(ICOM.EQ.'Y2TI')GOTO1600
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      GOTO9000
 1019 CONTINUE
C
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.1)GOTO1020
      GOTO1029
 1020 CONTINUE
      IF(IHARG(1).EQ.'XTIC')GOTO1100
      IF(IHARG(1).EQ.'X1TI')GOTO1200
      IF(IHARG(1).EQ.'X2TI')GOTO1300
      IF(IHARG(1).EQ.'YTIC')GOTO1400
      IF(IHARG(1).EQ.'Y1TI')GOTO1500
      IF(IHARG(1).EQ.'Y2TI')GOTO1600
      IF(IHARG(1).EQ.'TIC')GOTO1700
      IF(IHARG(1).EQ.'TICS')GOTO1700
      GOTO9000
 1029 CONTINUE
      GOTO9000
C
C               ********************************************************
C               **  STEP 1--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE HORIZONTAL MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1100 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1110
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1110
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1110
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1104)
 1104 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      (ON THE HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)
 1106 FORMAT('      MAJOR XTIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1107)
 1107 FORMAT('      MAJOR XTICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1180
C
 1160 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1JSW=IHHOLD
      IX2JSW=IHHOLD
      NMJX1T=IHOLD
      NMJX2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1183)IHOLD
 1183 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1184)
 1184 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 2--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE BOTTOM HORIZONTAL MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1200 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1210
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1210
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1210
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1201)
 1201 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1202)
 1202 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1203)
 1203 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1204)
 1204 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1205)
 1205 FORMAT('      (ON THE BOTTOM HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1206)
 1206 FORMAT('      MAJOR X1TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1207)
 1207 FORMAT('      MAJOR X1TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1210 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1280
C
 1260 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1JSW=IHHOLD
      NMJX1T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1283)IHOLD
 1283 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1284)
 1284 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO9000
 1290 CONTINUE
C
C               ********************************************************
C               **  STEP 3--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE TOP    HORIZONTAL MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1300 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1310
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1310
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1310
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1301)
 1301 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1302)
 1302 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1303)
 1303 FORMAT('      NUMBER OF MAJOR (HORIZONTAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1304)
 1304 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1305)
 1305 FORMAT('      (ON THE TOP HORIZONTAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1306)
 1306 FORMAT('      MAJOR X2TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1307)
 1307 FORMAT('      MAJOR X2TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1310 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1380
C
 1360 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2JSW=IHHOLD
      NMJX2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1383)IHOLD
 1383 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1384)
 1384 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO9000
 1390 CONTINUE
C
C               ********************************************************
C               **  STEP 4--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE VERTICAL    MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1400 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1410
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1410
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1410
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1401)
 1401 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1402)
 1402 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1403)
 1403 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1404)
 1404 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1405)
 1405 FORMAT('      (ON THE VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1406)
 1406 FORMAT('      MAJOR YTIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1407)
 1407 FORMAT('      MAJOR YTICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1410 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1480
C
 1460 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1JSW=IHHOLD
      IY2JSW=IHHOLD
      NMJY1T=IHOLD
      NMJY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1483)IHOLD
 1483 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1484)
 1484 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO9000
 1490 CONTINUE
C
C               ********************************************************
C               **  STEP 5--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE LEFT VERTICAL MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1500 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1510
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1510
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1510
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1501)
 1501 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1502)
 1502 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1503)
 1503 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1504)
 1504 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1505)
 1505 FORMAT('      (ON THE LEFT VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1506)
 1506 FORMAT('      MAJOR Y1TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1507)
 1507 FORMAT('      MAJOR Y1TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1510 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1580
C
 1560 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1JSW=IHHOLD
      NMJY1T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)
 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1583)IHOLD
 1583 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1584)
 1584 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO9000
 1590 CONTINUE
C
C               ********************************************************
C               **  STEP 6--
C               **  TREAT THE CASE WHEN
C               **  ONLY THE RIGHT VERTICAL MAJOR TICS ARE TO BE CHANGED
C               ********************************************************
C
 1600 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1610
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1610
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1610
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1601)
 1601 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1602)
 1602 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1603)
 1603 FORMAT('      NUMBER OF MAJOR (VERTICAL) TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1604)
 1604 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1605)
 1605 FORMAT('      (ON THE RIGHT VERTICAL FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1606)
 1606 FORMAT('      MAJOR Y2TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1607)
 1607 FORMAT('      MAJOR Y2TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1610 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1680
C
 1660 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2JSW=IHHOLD
      NMJY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)
 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1683)IHOLD
 1683 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1684)
 1684 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO9000
 1690 CONTINUE
C
C               ********************************************************
C               **  STEP 7--
C               **  TREAT THE CASE WHEN
C               **  BOTH HORIZONTAL AND VERTICAL    MAJOR TICS ARE TO BE
C               ********************************************************
C
 1700 CONTINUE
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1710
      IF(ICOM.NE.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO1710
      IF(ICOM.EQ.'MAJO'.AND.NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO1710
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1701)
 1701 FORMAT('***** ERROR IN DPMATN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1702)
 1702 FORMAT('      IMPROPER FORM FOR SPECIFYING THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1703)
 1703 FORMAT('      NUMBER OF MAJOR TIC MARKS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1704)
 1704 FORMAT('      EXAMPLE TO SPECIFY 3 MAJOR TIC MARKS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1705)
 1705 FORMAT('      (ON ALL 4 FRAME LINES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1706)
 1706 FORMAT('      MAJOR TIC MARK NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1707)
 1707 FORMAT('      MAJOR TICS NUMBER 3')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1710 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'NUMB')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      IHHOLD='FLOA'
      IHOLD=(-1)
      GOTO1780
C
 1760 CONTINUE
      IHHOLD='FIXE'
      IHOLD=IARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1JSW=IHHOLD
      IX2JSW=IHHOLD
      IY1JSW=IHHOLD
      IY2JSW=IHHOLD
      NMJX1T=IHOLD
      NMJX2T=IHOLD
      NMJY1T=IHOLD
      NMJY2T=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE NUMBER OF MAJOR TIC MARKS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)
 1782 FORMAT('(FOR EACH FRAME LINES')
      CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FIXE')WRITE(ICOUT,1783)IHOLD
 1783 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IHHOLD.EQ.'FIXE')CALL DPWRST('XXX','BUG ')
      IF(IHHOLD.EQ.'FLOA')WRITE(ICOUT,1784)
 1784 FORMAT('HAS JUST BEEN SET TO AUTOMATIC.')
      IF(IHHOLD.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO9000
 1790 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPMAX(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MAX,GY1MAX,
     1GX2MAX,GY2MAX,
     1IX1MAX,IY1MAX,
     1IX2MAX,IY2MAX,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE AXIS MAXIMA
C              (HORIZONTAL AXIS OR VERTICAL AXIS OR BOTH)
C              WHICH IN TURN WILL DEFINE THE UPPER EXTREME
C              WHICH WILL APPEAR ON THE PLOT.
C              THE MAXIMA WILL BE PLACED IN THE 4 VARIABLES
C              GX1MAX,GY1MAX,
C              GX2MAX,GY2MAX,
C              THE STATUS (FIXED OR FLOAT) WILL BE PLACED
C              IN THE 4 VARIABLES
C              IX1MAX,IY1MAX,
C              IX2MAX,IY2MAX,
C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --GX1MAX = MAXIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --GY1MAX = MAXIMUM FOR LEFT   VERTICAL   AXIS
C                     --GX2MAX = MAXIMUM FOR TOP    HORIZONTAL AXIS
C                     --GX2MAX = MAXIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IX1MAX = STATUS FOR MAXIMUM FOR BOTTOM HORIZONTAL AXIS
C                     --IY1MAX = STATUS FOR MAXIMUM FOR LEFT   VERTICAL   AXIS
C                     --IX2MAX = STATUS FOR MAXIMUM FOR TOP    HORIZONTAL AXIS
C                     --IX2MAX = STATUS FOR MAXIMUM FOR RIGHT  VERTICAL   AXIS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY 1992.  FIX YMAX WITH NO ARG BOMB
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IX1MAX
      CHARACTER*4 IY1MAX
      CHARACTER*4 IX2MAX
      CHARACTER*4 IY2MAX
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.LE.0)GOTO1090
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH HORIZONTAL AXIS MAXIMA ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XMAX')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IARGT(1).EQ.'NUMB')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      IFOUND='YES'
      GX1MAX=CPUMAX
      GX2MAX=CPUMAX
      IX1MAX='FLOA'
      IX2MAX='FLOA'
 1113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE X AXIS MAXIMUM (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO9000
C
 1120 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MAX=A1
      GX2MAX=A1
      IX1MAX='FIXE'
      IX2MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE X AXIS MAXIMUM (FOR BOTH HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)GX1MAX
 1126 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  BOTTOM HORIZONTAL AXIS MAXIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X1MA')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IARGT(1).EQ.'NUMB')GOTO1220
      GOTO1210
C
 1210 CONTINUE
      IFOUND='YES'
      GX1MAX=CPUMAX
      IX1MAX='FLOA'
 1213 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X AXIS MAXIMUM (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO9000
C
 1220 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MAX=A1
      IX1MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X AXIS MAXIMUM (FOR THE BOTTOM HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1226)GX1MAX
 1226 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO9000
C
 1299 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  TOP    HORIZONTAL AXIS MAXIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'X2MA')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IARGT(1).EQ.'NUMB')GOTO1320
      GOTO1310
C
 1310 CONTINUE
      IFOUND='YES'
      GX2MAX=CPUMAX
      IX2MAX='FLOA'
 1313 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X AXIS MAXIMUM (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)
 1317 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO9000
C
 1320 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX2MAX=A1
      IX2MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X AXIS MAXIMUM (FOR THE TOP    HORIZONTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)GX2MAX
 1326 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO9000
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH VERTICAL   AXIS MAXIMUM ARE TO BE FIXED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YMAX')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IARGT(1).EQ.'NUMB')GOTO1420
      GOTO1410
C
 1410 CONTINUE
      IFOUND='YES'
      GY1MAX=CPUMAX
      GY2MAX=CPUMAX
      IY1MAX='FLOA'
      IY2MAX='FLOA'
 1413 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE Y AXIS MAXIMUM (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)
 1416 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO9000
C
 1420 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY1MAX=A1
      GY2MAX=A1
      IY1MAX='FIXE'
      IY2MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE Y AXIS MAXIMUM (FOR BOTH VERTICAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1426)GY1MAX
 1426 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO9000
C
 1499 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  LEFT   VERTICAL   AXIS MAXIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y1MA')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IARGT(1).EQ.'NUMB')GOTO1520
      GOTO1510
C
 1510 CONTINUE
      IFOUND='YES'
      GY1MAX=CPUMAX
      IY1MAX='FLOA'
 1513 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y AXIS MAXIMUM (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1516)
 1516 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1517)
 1517 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO9000
C
 1520 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY1MAX=A1
      IY1MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y AXIS MAXIMUM (FOR THE LEFT   VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1526)GY1MAX
 1526 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO9000
C
 1599 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN THE                        **
C               **  RIGHT  VERTICAL   AXIS MAXIMUM ARE TO BE FIXED  **
C               *****************************************************
C
      IF(ICOM.EQ.'Y2MA')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IARGT(1).EQ.'NUMB')GOTO1620
      GOTO1610
C
 1610 CONTINUE
      IFOUND='YES'
      GY2MAX=CPUMAX
      IY2MAX='FLOA'
 1613 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y AXIS MAXIMUM (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)
 1616 FORMAT('FRAME LINE) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1617)
 1617 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO9000
C
 1620 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GY2MAX=A1
      IY2MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y AXIS MAXIMUM (FOR THE RIGHT  VERTICAL  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1626)GY2MAX
 1626 FORMAT('FRAME LINE) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO9000
C
 1699 CONTINUE
C
C               ******************************************
C               **  TREAT THE CASE WHEN                 **
C               **  BOTH AXIS MAXIMUM ARE TO BE FIXED    **
C               ******************************************
C
C
      IF(ICOM.EQ.'XYMA')GOTO1700
      IF(ICOM.EQ.'YXMA')GOTO1700
      IF(ICOM.EQ.'MAXI')GOTO1700
      IF(ICOM.EQ.'MAX ')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IARGT(1).EQ.'NUMB')GOTO1720
      GOTO1710
C
 1710 CONTINUE
      IFOUND='YES'
      GX1MAX=CPUMAX
      GY1MAX=CPUMAX
      GX2MAX=CPUMAX
      GY2MAX=CPUMAX
      IX1MAX='FLOA'
      IY1MAX='FLOA'
      IX2MAX='FLOA'
      IY2MAX='FLOA'
 1713 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE X AXIS MAXIMUM (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1716)
 1716 FORMAT('FRAME LINES) HAS JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1717)
 1717 FORMAT('SO THAT IT WILL FLOAT WITH THE PLOTTED DATA')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO9000
C
 1720 CONTINUE
      IFOUND='YES'
      A1=ARG(1)
      GX1MAX=A1
      GY1MAX=A1
      GX2MAX=A1
      GY2MAX=A1
      IX1MAX='FIXE'
      IY1MAX='FIXE'
      IX2MAX='FIXE'
      IY2MAX='FIXE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE AXIS MAXIMUM (FOR ALL 4')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1726)GX1MAX
 1726 FORMAT('FRAME LINES) HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO9000
C
 1799 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('THE CURRENT AXIS MAXIMA ARE ')
      CALL DPWRST('XXX','BUG ')
      IF(IX1MAX.NE.'FLOA')WRITE(ICOUT,8112)GX1MAX
 8112 FORMAT('            --X1 (BOTTOM HORIZONTAL) = ',E15.7)
      IF(IX1MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX1MAX.EQ.'FLOA')WRITE(ICOUT,8113)
 8113 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      IF(IX1MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX2MAX.NE.'FLOA')WRITE(ICOUT,8114)GX2MAX
 8114 FORMAT('            --X2 (TOP    HORIZONTAL) = ',E15.7)
      IF(IX2MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IX2MAX.EQ.'FLOA')WRITE(ICOUT,8115)
 8115 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      IF(IX2MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY1MAX.NE.'FLOA')WRITE(ICOUT,8116)GY1MAX
 8116 FORMAT('            --Y1 (LEFT   VERTICAL  ) = ',E15.7)
      IF(IY1MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY1MAX.EQ.'FLOA')WRITE(ICOUT,8117)
 8117 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      IF(IY1MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY2MAX.NE.'FLOA')WRITE(ICOUT,8118)GY2MAX
 8118 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = ',E15.7)
      IF(IY2MAX.NE.'FLOA')CALL DPWRST('XXX','BUG ')
      IF(IY2MAX.EQ.'FLOA')WRITE(ICOUT,8119)
 8119 FORMAT('            --Y2 (RIGHT  VERTICAL  ) = FLOAT & NEAT')
      IF(IY2MAX.EQ.'FLOA')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)
 8121 FORMAT('THE DEFAULT AXIS MAXIMA ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)
 8122 FORMAT('            --X1 (BOTTOM HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8123)
 8123 FORMAT('            --X2 (TOP    HORIZONTAL) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8124)
 8124 FORMAT('            --Y1 (LEFT   VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8125)
 8125 FORMAT('            --Y2 (BOTTOM VERTICAL  ) = FLOAT & NEAT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPMBCO(IHARG,NUMARG,IDEMBC,MAXMAR,IMABCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER BORDER COLORS = THE COLORS
C              OF THE BORDER LINE AROUND THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMABCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMBC
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMABCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMBC
      CHARACTER*4 IMABCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMABCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMB'
      ISUBN2='CO  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMBC
   55 FORMAT('IDEMBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMABCO(1)
   70 FORMAT('IMABCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMABCO(I)
   76 FORMAT('I,IMABCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMABCO(1)=IDEMBC
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBC
      IMABCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMABCO(I)
 1276 FORMAT('THE COLOR OF MARKER BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBC
      DO1315I=1,NUMMAR
      IMABCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMABCO(I)
 1316 FORMAT('THE COLOR OF ALL MARKER BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMBC
 9015 FORMAT('IDEMBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMABCO(1)
 9030 FORMAT('IMABCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMABCO(I)
 9036 FORMAT('I,IMABCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMBLI(IHARG,IHARG2,NUMARG,IDEMBL,MAXMAR,IMABLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPMBLI(IHARG,NUMARG,IDEMBL,MAXMAR,IMABLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
C              OF THE BORDER AROUND THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMABLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMBL
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMABLI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEMBL
      CHARACTER*4 IMABLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IMABLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMB'
      ISUBN2='LI  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMBL
   55 FORMAT('IDEMBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMABLI(1)
   70 FORMAT('IMABLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMABLI(I)
   76 FORMAT('I,IMABLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMABLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-3
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBL
      IMABLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMABLI(I)
 1276 FORMAT('THE LINE TYPE FOR MARKER BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMBL
      DO1315I=1,NUMMAR
      IMABLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMABLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL MARKER BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMBL
 9015 FORMAT('IDEMBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMABLI(1)
 9030 FORMAT('IMABLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMABLI(I)
 9036 FORMAT('I,IMABLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMBTH(IHARG,IARGT,ARG,NUMARG,PDEMBT,MAXMAR,PMABTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER (BORDER) LINE THICKNESSES = THE THICKNESSES
C              OF THE BORDER LINE AROUND THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR PMABTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEMBT
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PMABTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PMABTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMB'
      ISUBN2='TH  '
C
      NUMMAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEMBT
   55 FORMAT('PDEMBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PMABTH(1)
   70 FORMAT('PMABTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PMABTH(I)
   76 FORMAT('I,PMABTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEMBT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      PMABTH(1)=PDEMBT
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMBT
      PMABTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,PMABTH(I)
 1276 FORMAT('THE THICKNESS OF MARKER BORDER ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEMBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEMBT
      DO1315I=1,NUMMAR
      PMABTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PMABTH(I)
 1316 FORMAT('THE THICKNESS OF ALL MARKER BORDERS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEMBT
 9015 FORMAT('PDEMBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PMABTH(1)
 9030 FORMAT('PMABTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PMABTH(I)
 9036 FORMAT('I,PMABTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMED3(X1,X2,X3,XMED3,IBUGG3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE MEDIAN
C              OF THE 3 NUMBERS X1, X2, AND X3.
C     OUTPUT ARGUMENTS--XMED3  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE MEDIAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE MEDIAN.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--MCNEIL, INTERACTIVE DATA ANALYSIS
C                 1977, PAGE 145
C                 (= SOURCE OF ALGORITHM).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION--JULY      1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMED3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3
   52 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,X2,X3
   53 FORMAT('X1,X2,X3 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************
C               **  COMPUTE MEDIAN  **
C               **********************
C
      XMED3=X2
      IF(X1.LE.X2.AND.X2.LE.X3)GOTO9000
      IF(X3.LE.X2.AND.X2.LE.X1)GOTO9000
C
      XMED3=X1
      IF(X2.LE.X1.AND.X1.LE.X3)GOTO9000
      IF(X3.LE.X1.AND.X1.LE.X2)GOTO9000
C
      XMED3=X3
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMED3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,IERROR
 9012 FORMAT('IBUGG3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,X2,X3
 9013 FORMAT('X1,X2,X3 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)XMED3
 9014 FORMAT('XMED3 = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMENU(ICOM,ICOM2,ICOMT,ICOMI,
     1IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IMENSW,
     1IME1CO,IME1AL,IME2CO,IME2AL,
     1IME3CO,IME3AL,IME4CO,IME4AL,
     1IME5CO,IME5AL,IME6CO,IME6AL,
     1IME7CO,IME7AL,IME8CO,IME8AL,
     1IME9CO,IME9AL,IM10CO,IM10AL,
     1IM11CO,IM11AL,IM12CO,IM12AL,
     1IM13CO,IM13AL,IM14CO,IM14AL,
     1IM15CO,IM15AL,IM16CO,IM16AL,
     1IM17CO,IM17AL,IM18CO,IM18AL,
     1IM19CO,IM19AL,IM20CO,IM20AL,
     1IMENCO,IMENAL,
     1IHELMX,ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IANS,IWIDTH,IBUGME,IBUGM2,ISUBRO,IFOUND,IERROR)
CCCCC THE ABOVE ARG LIST EXPANDED AUGUST 1990
CCCCC THE IHELMX LINE WAS ADDED TO ABOVE ARGUMENT LIST AUGUST 1990
C
C     PURPOSE--DETERMINE IF DATAPLOT'S MENU   SYSTEM
C              COMMAND IS BEING INVOKED AND/OR
C              DETERMINE IF A USER'S MENU DESIGNATION IS VALID.
C              THIS SUBROUTINE IN TURN CALLS DPMEN2
C              WHICH READS THE DESIGNATED MENU
C              FROM (ONE OF) DATAPLOT'S MENU   SUB-SYSTEM FILE(S),
C              AND WRITES THE MENU OUT TO SCREEN.
C     INPUT  ARGUMENTS--ICOM ETC.
C     OUTPUT ARGUMENTS--IMENSW, IMENCO, AND IMENAL
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/7
C     ORIGINAL VERSION--JUNE      1990.
C     UPDATED         --AUGUST 1990. MENU 11 TO 20
C     UPDATED         --AUGUST 1990. NEW INPUT ARGUMENTS
C     UPDATED         --AUGUST 1990. NEW MENU
C     UPDATED         --AUGUST 1990. MORE/PAUSE WITH MENU
C     UPDATED         --AUGUST 1990. TOP AND T
C     UPDATED         --AUGUST 1990. UP AND U
C     UPDATED         --MARCH  1993. CONFLICTS WITH T TEST, T PPF, AND
C                                    T PROBABILTY PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICOMT
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IMENSW
C
      CHARACTER*12 IME1CO
      CHARACTER*4 IME1AL
C
      CHARACTER*12 IME2CO
      CHARACTER*4 IME2AL
C
      CHARACTER*12 IME3CO
      CHARACTER*4 IME3AL
C
      CHARACTER*12 IME4CO
      CHARACTER*4 IME4AL
C
      CHARACTER*12 IME5CO
      CHARACTER*4 IME5AL
C
      CHARACTER*12 IME6CO
      CHARACTER*4 IME6AL
C
      CHARACTER*12 IME7CO
      CHARACTER*4 IME7AL
C
      CHARACTER*12 IME8CO
      CHARACTER*4 IME8AL
C
      CHARACTER*12 IME9CO
      CHARACTER*4 IME9AL
C
CCCCC THE FOLLOWING 11 SECTIONS (10 TO 20) WERE ADDED AUGUST 1990
      CHARACTER*12 IM10CO
      CHARACTER*4 IM10AL
C
      CHARACTER*12 IM11CO
      CHARACTER*4 IM11AL
C
      CHARACTER*12 IM12CO
      CHARACTER*4 IM12AL
C
      CHARACTER*12 IM13CO
      CHARACTER*4 IM13AL
C
      CHARACTER*12 IM14CO
      CHARACTER*4 IM14AL
C
      CHARACTER*12 IM15CO
      CHARACTER*4 IM15AL
C
      CHARACTER*12 IM16CO
      CHARACTER*4 IM16AL
C
      CHARACTER*12 IM17CO
      CHARACTER*4 IM17AL
C
      CHARACTER*12 IM18CO
      CHARACTER*4 IM18AL
C
      CHARACTER*12 IM19CO
      CHARACTER*4 IM19AL
C
      CHARACTER*12 IM20CO
      CHARACTER*4 IM20AL
C
      CHARACTER*12 IMENCO
      CHARACTER*4 IMENAL
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGME
      CHARACTER*4 IBUGM2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICJUNK
      CHARACTER*80 ISTRIN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOWI.INC'
      INCLUDE 'DPCONP.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ICURWI=0
C
   50 CONTINUE
C
      ISUBN1='DPME'
      ISUBN2='NU  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IMENAL='OFF'
C
      MAXCPS=12
C
      I2=(-999)
C
      IF(IBUGME.EQ.'OFF'.AND.ISUBRO.NE.'MENU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMENU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMENSW
   52 FORMAT('IMENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IME1CO,IME1AL
   61 FORMAT('IME1CO,IME1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IME2CO,IME2AL
   62 FORMAT('IME2CO,IME2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IME3CO,IME3AL
   63 FORMAT('IME3CO,IME3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IME4CO,IME4AL
   64 FORMAT('IME4CO,IME4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IME5CO,IME5AL
   65 FORMAT('IME5CO,IME5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IME6CO,IME6AL
   66 FORMAT('IME6CO,IME6AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IME7CO,IME7AL
   67 FORMAT('IME7CO,IME7AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IME8CO,IME8AL
   68 FORMAT('IME8CO,IME8AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IME9CO,IME9AL
   69 FORMAT('IME9CO,IME9AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 11 PAIRS OF LINES WERE ADDED AUGUST 1990
      WRITE(ICOUT,70)IM10CO,IM10AL
   70 FORMAT('IM10CO,IM10AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IM11CO,IM11AL
   71 FORMAT('IM11CO,IM11AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IM12CO,IM12AL
   72 FORMAT('IM12CO,IM12AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IM13CO,IM13AL
   73 FORMAT('IM13CO,IM13AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IM14CO,IM14AL
   74 FORMAT('IM14CO,IM14AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IM15CO,IM15AL
   75 FORMAT('IM15CO,IM15AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IM16CO,IM16AL
   76 FORMAT('IM16CO,IM16AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)IM17CO,IM17AL
   77 FORMAT('IM17CO,IM17AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)IM18CO,IM18AL
   78 FORMAT('IM18CO,IM18AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IM19CO,IM19AL
   79 FORMAT('IM19CO,IM19AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)IM20CO,IM20AL
   80 FORMAT('IM20CO,IM20AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IMENCO,IMENAL
   84 FORMAT('IMENCO,IMENAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IWIDTH
   85 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)(IANS(I),I=1,80)
   86 FORMAT('(IANS(I),I=1,80) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IBUGME,IBUGM2,IERROR
   87 FORMAT('IBUGME,IBUGM2,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************************
C               **  STEP 11--                                               **
C               **  DETERMINE IF HAVE AN MENU   COMMAND, OR                 **
C               **            IF HAVE A MENU RESPONSE NUMBER TO A MENU, OR  **
C               **            IF HAVE NEITHER.                              **
C               **************************************************************
C
 1100 CONTINUE
      ISTEPN='11'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'MENU')GOTO1200
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'TOP')GOTO1200
CCCCC DECEMBER 1992.  CHECK FOR CONFLICT WITH T TEST
CCCCC MARCH 1993.  CHECK FOR CONFLICT WITH T PPCC PLOT
CCCCC MARCH 1993.  CHECK FOR CONFLICT WITH T PROB PLOT
CCCCC IF(ICOM.EQ.'T')GOTO1200
CCCCC IF(ICOM.EQ.'T'.AND.IHARG(1).NE.'TEST')GOTO1200
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'TEST')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'PPCC')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'PROB')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'KOLM')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'CHIS')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'CHI ')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'KS  ')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'CENS')GOTO1109
      IF(ICOM.EQ.'T'.AND.IHARG(1).EQ.'PLOT')GOTO1109
      IF(ICOM.EQ.'BOOT')GOTO1109
      IF(ICOM.EQ.'T')GOTO1200
 1109 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'UP')GOTO1600
CCCCC DECEMBER 1992.  CHECK FOR CONFLICT WITH U CHART
CCCCC IF(ICOM.EQ.'U')GOTO1600
      IF(ICOM.EQ.'U'.AND.IHARG(1).NE.'CHAR')GOTO1600
      IF(ICOM(1:1).EQ.IESCC)GOTO1600
      IF(ICOM.EQ.'.')GOTO9000
      IF(ICOM.EQ.' ')GOTO9000
      IF(ICOM.EQ.'P'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO9000
      IF(ICOM.EQ.'P'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO9000
      IF(ICOM.EQ.'P')GOTO1700
CCCCC IF(NUMARG.LE.0.AND.ICOM.EQ.' ')GOTO2100
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.EQ.0)GOTO2300
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.GT.0)GOTO1500
      IF(NUMARG.LE.0.AND.ICOMT.EQ.'NUMB'.AND.ICOMI.LT.0)GOTO1600
      GOTO9000
C
C               ***************************************
C               **  STEP 12--                        **
C               **  TREAT THE CASE WHEN HAVE         **
C               **  AN EXPLICIT    MENU     COMMAND  **
C               ***************************************
C
 1200 CONTINUE
      ISTEPN='12'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO2100
      IF(IHARG(1).EQ.'LAST')GOTO2100
      IF(IHARG(1).EQ.'?')GOTO2100
      IF(IHARG(1).EQ.'ALL')IMENAL='ON'
      IF(IHARG(1).EQ.'ALL')GOTO2100
C
      IF(IHARG(1).EQ.'UP')GOTO1300
      IF(IHARG(1).EQ.'PRIO')GOTO1300
      IF(IHARG(1).EQ.'PREV')GOTO1300
      IF(IHARG(1).EQ.'BEFO')GOTO1300
C
      GOTO1400
C
C               ****************************************
C               **  STEP 13  --                       **
C               **  TREAT THE    MENU   UP #    CASE  **
C               ****************************************
C
 1300 CONTINUE
      ISTEPN='13'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMENCO.EQ.'0           ')IMENSW='TOP'
      IF(IMENCO.EQ.'0           ')GOTO2100
      IF(IMENCO.EQ.'            ')IMENSW='TOP'
      IF(IMENCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')NLOOP=IARG(2)
      IF(NLOOP.LE.1)NLOOP=1
C
      DO1310ILOOP=1,NLOOP
C
      DO1320I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IMENCO(IREV:IREV).EQ.'.')GOTO1325
      IMENCO(IREV:IREV)=' '
 1320 CONTINUE
      GOTO1310
 1325 CONTINUE
      IMENCO(IREV:IREV)=' '
      GOTO1310
C
 1310 CONTINUE
      GOTO2100
C
C               *************************************
C               **  STEP 14--                      **
C               **  TREAT THE    MENU   #    CASE  **
C               *************************************
C
 1400 CONTINUE
      ISTEPN='14'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DP')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DATA')GOTO1490
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COMM')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FUNC')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TEXT')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEXP')GOTO1490
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TUTO')GOTO1490
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'I/O')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'GRAP')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'STAT')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'STAC')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'STAI')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'PROB')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MATH')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SCIE')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ENGI')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'BUSI')GOTO1490
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MISC')GOTO1490
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IMENCO(1:4)=IH11(1:4)
      IMENCO(5:8)=IH12(1:4)
      IMENCO(9:12)='    '
C
 1490 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 15--                          **
C               **  TREAT THE    #    CASE             **
C               **  (AS IN RESPONDING TO A MENU        **
C               **  BY SPECIFYING A MENU ITEM CHOICE)  **
C               *****************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMENSW.EQ.'TOP')IMENCO='0           '
      IF(IMENSW.EQ.'TOP')GOTO2100
C
      IF(IMENCO(1:1).EQ.'0')GOTO1510
      GOTO1520
C
 1510 CONTINUE
      I2=0
      GOTO1530
C
 1520 CONTINUE
      DO1525I=1,MAXCPS
      I2=I
      IF(IMENCO(I2:I2).EQ.' ')GOTO1526
 1525 CONTINUE
      GOTO1539
 1526 CONTINUE
      IMENCO(I2:I2)='.'
      GOTO1530
C
 1530 CONTINUE
      DO1535J=1,4
      I2=I2+1
      IF(I2.GT.MAXCPS)GOTO1539
      IMENCO(I2:I2)=ICOM(J:J)
 1535 CONTINUE
 1539 CONTINUE
      GOTO2100
C
C               *****************************************
C               **  STEP 16--                          **
C               **  TREAT THE   -#    CASE             **
C               **  (AS IN CALLING FOR PRIOR MENUS     **
C               *****************************************
C
 1600 CONTINUE
      ISTEPN='16'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMENCO.EQ.'0           ')IMENSW='TOP'
      IF(IMENCO.EQ.'0           ')GOTO2100
      IF(IMENCO.EQ.'            ')IMENSW='TOP'
      IF(IMENCO.EQ.'            ')GOTO2100
C
      NLOOP=1
      IF(ICOMT.EQ.'NUMB')NLOOP=(-ICOMI)
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'UP'.AND.NUMARG.LE.0)GOTO1609
      IF(ICOM.EQ.'U'.AND.NUMARG.LE.0)GOTO1609
      IF(ICOM.EQ.'UP'.AND.NUMARG.GE.1)NLOOP=IARG(1)
      IF(ICOM.EQ.'U'.AND.NUMARG.GE.1)NLOOP=IARG(1)
 1609 CONTINUE
C
      IF(NLOOP.LE.0)GOTO1619
      DO1610ILOOP=1,NLOOP
C
      DO1620I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IMENCO(IREV:IREV).EQ.'.')GOTO1621
      IMENCO(IREV:IREV)=' '
 1620 CONTINUE
      GOTO1610
 1621 CONTINUE
      IMENCO(IREV:IREV)=' '
      GOTO1610
C
 1610 CONTINUE
C
 1619 CONTINUE
CCCCC IF(NLOOP.LE.0)GOTO1639
CCCCC DO1630ILOOP=1,NLOOP
CCCCC IF(IWINSY.EQ.'OTG')GOTO1632
CCCCC GOTO1630
C1632 CONTINUE
CCCCC CALL WICLOS('ON  ','OFF ',ICURWI)
CCCCC IF(ICURWI.LE.2)CALL WIEXIT('ON  ')
CCCCC ICURWI=ICURWI-1
CCCCC GOTO1630
C1630 CONTINUE
C1639 CONTINUE
C
      GOTO2100
C
C               *****************************************
C               **  STEP 17--                          **
C               **  TREAT THE CASE WHEN HAVE AN EXPLICIT
C               **  P COMMAND ( P AS IN 'PREVIOUS')
C               **  TREAT THE   p #    CASE             **
C               **  (AS IN CALLING FOR ITEM #     **
C               **  OF THE PREVIOUS MENU (A BASE MENU)
C               *****************************************
C
 1700 CONTINUE
      ISTEPN='17'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IMENCO.EQ.'0           ')IMENSW='TOP'
      IF(IMENCO.EQ.'0           ')GOTO2100
      IF(IMENCO.EQ.'            ')IMENSW='TOP'
      IF(IMENCO.EQ.'            ')GOTO2100
C
      IF(NUMARG.LE.0)GOTO2100
      DO1720I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IMENCO(IREV:IREV).EQ.'.')GOTO1721
      IMENCO(IREV:IREV)=' '
 1720 CONTINUE
      IMENSW='TOP'
      GOTO2100
 1721 CONTINUE
      I2=IREV
      GOTO1730
C
 1730 CONTINUE
      DO1735J=1,4
      I2=I2+1
      IF(I2.GT.MAXCPS)GOTO1739
      ICJUNK=IHARG(1)
      IMENCO(I2:I2)=ICJUNK(J:J)
 1735 CONTINUE
 1739 CONTINUE
      GOTO2100
C
 1719 CONTINUE
      GOTO2100
C
C               *************************************************
C               **  STEP 18--                                  **
C               **  STRIP OFF TRAILING PERIOD (IF ONE EXISTS)  **
C               *************************************************
C
 1800 CONTINUE
      ISTEPN='18'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1810I=1,MAXCPS
      IREV=MAXCPS-I+1
      IF(IMENCO(IREV:IREV).NE.' ')GOTO1811
 1810 CONTINUE
      GOTO1890
 1811 CONTINUE
      IF(IMENCO(IREV:IREV).EQ.'.')IMENCO(IREV:IREV)=' '
      GOTO1890
 1890 CONTINUE
C
C               *********************************************
C               **  STEP 21--                              **
C               **  BRANCH BETWEEN THE OVERALL MENU        **
C               **  OR THE GENERAL MENU WITHIN EACH AREA.  **
C               *********************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFOUND='YES'
      IF(IMENCO.EQ.'            ')IMENCO='0           '
      IF(ICOM.EQ.'MENU'.AND.NUMARG.LE.0)GOTO2200
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'TOP'.AND.NUMARG.LE.0)GOTO2200
      IF(ICOM.EQ.'T'.AND.NUMARG.LE.0)GOTO2200
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'UP'.AND.IMENSW.EQ.'TOP')GOTO2200
      IF(ICOM.EQ.'U'.AND.IMENSW.EQ.'TOP')GOTO2200
      IF(IMENSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOM.EQ.' ')GOTO2200
      IF(IMENSW.EQ.'TOP'.AND.NUMARG.LE.0.AND.
     1ICOMT.EQ.'NUMB'.AND.ICOMI.LE.0)GOTO2200
      GOTO2300
C
C               **********************************************
C               **  STEP 22--                               **
C               **  WRITE (TO THE SCREEN) THE OVERALL MENU  **
C               **********************************************
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMENSW='TOP'
C
CCCCC WRITE(ICOUT,2211)IESCC,IFFC
C2211 FORMAT(2A1)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2212)IESCC
C2212 FORMAT(A1,'8')
CCCCC CALL DPWRST('XXX','BUG ')
C
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990
C
      IF(IWINSY.EQ.'NONE')GOTO2220
      GOTO2250
C
 2220 CONTINUE
      WRITE(ICOUT,2221)
 2221 FORMAT('For menu assistance at any time, enter   HELP MENU')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2224)
 2224 FORMAT('------------------------------------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2230)
 2230 FORMAT('            Top Menu')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2231)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2232)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2233)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2234)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2235)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2236)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2237)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2238)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2239)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2240)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2241)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2242)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2243)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2244)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2245)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2246)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2247)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2248)
CCCCC CALL DPWRST('XXX','BUG ')
C
 2231 FORMAT(5X,'  1. Dataplot    --General')
 2232 FORMAT(5X,'  2.             --On-line Data Files')
 2233 FORMAT(5X,'  3.             --Commands +')
 2234 FORMAT(5X,'  4.             --Built-in Functions')
 2235 FORMAT(5X,'  5.             --TEXT Subcommands')
 2236 FORMAT(5X,'  6.             --Exp. Design Tables')
 2237 FORMAT(5X,'  7.             --Input/Output')
 2238 FORMAT(5X,'  8.             --Tutorial Examples')
 2239 FORMAT(5X,'  9. Techniques  --Graphics')
 2240 FORMAT(5X,' 10.             --Statistics--Classical')
 2241 FORMAT(5X,' 11.             --Statistics--Industrial')
 2242 FORMAT(5X,' 12.             --Experiment Design')
 2243 FORMAT(5X,' 13.             --Probability')
 2244 FORMAT(5X,' 14.             --Mathematics')
 2245 FORMAT(5X,' 15. Applications--Science')
 2246 FORMAT(5X,' 16.             --Engineering')
 2247 FORMAT(5X,' 17.             --Business')
 2248 FORMAT(5X,' 18. Miscellaneous')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      GOTO2290
C
 2250 CONTINUE
CCCCC IF(ICURWI.LE.0)CALL WIINWS('OFF ')
      IF(ICURWI.LE.0)CALL SHINIT(' ')
      ICURWI=1
CCCCC CALL WISEWI(ICURWI)
CCCCC CALL WNSEL(1)
CCCCC CALL WISECO('BLUE','WHIT')
      CALL WNACTN('FC')
      CALL COLOR('RED ','GREE')
CCCCC CALL WISETY('PERM')
CCCCC CALL WISEFR('ON  ')
CCCCC CALL WNACTN('FC')
CCCCC CALL WISELS(1,23,40,1)
CCCCC CALL WISEWR('OFF ')
CCCCC CALL WNWRAP('OFF ')
CCCCC CALL WIOPWI
CCCCC CALL WNOPEN(1,23,40,1)
CCCCC CALL WNOPEN(1,10,40,5)
      CALL WNOPEN(IXJUNK,IYJUNK,IXJNK2,IYJNK2)
CCCCC CALL WIERWI
CCCCC CALL WNCLR
CCCCC CALL WIMOHO
CCCCC CALL WNHOME
      CALL WNOUSX(3,3,'ABCDEF')
      CALL WNCLOS(0)
CCCCC THE FOLLOWING LINE IS TEMPORARY
CCCCC IFLAG=0
      IFLAG=1
      IF(IFLAG.EQ.0)GOTO9999
      GOTO9000
C
 9999 CONTINUE
      ICURWI=2
CCCCC CALL WISEWI(ICURWI)
      CALL WNSEL(2)
      MENWID=40
      IX=1
      IY=1
      IXLEN=MENWID
      IYLEN=20
CCCCC CALL WISECO('BLUE','WHIT')
      CALL COLOR('WHIT','BLUE')
CCCCC CALL WISETY('POP ')
CCCCC CALL WISEFR('ON  ')
      CALL WNACTN('FCP')
CCCCC CALL WISELS(IX,IY,IXLEN,IYLEN)
CCCCC CALL WISEWR('OFF ')
      CALL WNWRAP('OFF ')
CCCCC CALL WIOPWI
      CALL WNOPEN(IX,IY,IXLEN,IYLEN)
CCCCC CALL WIERWI
      CALL WNCLR
CCCCC CALL WIMOHO
      CALL WNHOME
C
      IY=0
      IY=IY+1
      ISTRIN='             Top Menu'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' '
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  1. Dataplot    --General'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  2.             --On-line Data Files'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  3.             --Commands +'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  4.             --Built-in Functions'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  5.             --TEXT Subcommands'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  6.             --Exp. Design Tables'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  7.             --Input/Output'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' '
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  8.             --Tutorial Examples'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN='  9. Techniques  --Graphics'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 10.             --Statistics--Classical'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 11.             --Statistics--Industrial'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 12.             --Experiment Design'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 13.             --Probability'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 14.             --Mathematics'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' '
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 15. Applications--Science'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 16.             --Engineering'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
      IY=IY+1
      ISTRIN=' 17.             --Business'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
      CALL WNOUSX(1,IY,ISTRIN)
CCCCC IY=IY+1
CCCCC ISTRIN=' '
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
CCCCC IY=IY+1
CCCCC ISTRIN=' 18. Miscellaneous'
CCCCC CALL WIMWST(1,IY,ISTRIN,80)
C
CCCCC CALL WISEWI(1)
      CALL WNSEL(1)
CCCCC CALL WIERWI
      CALL WNCLR
      ISTRIN='>'
CCCCC CALL WIMWST(1,1,ISTRIN,1)
      CALL WNOUSX(1,1,ISTRIN)
CCCCC CAUTION--THE FOLLOWING LINE REDEFINES THE INPUT VARIABLE ICOM
CCCCC CALL WIREST(ISTRIN,LENGTH)
      CALL INSTR(ISTRIN,LENGTH)
      ICOM(1:4)=ISTRIN(1:4)
      NUMARG=0
      ICOM2='    '
      ICOMT='NUMB'
      ICOMI=0
      IF(ICOM.EQ.'1')ICOMI=1
      IF(ICOM.EQ.'2')ICOMI=2
      IF(ICOM.EQ.'3')ICOMI=3
      IF(ICOM.EQ.'4')ICOMI=4
      IF(ICOM.EQ.'5')ICOMI=5
      IF(ICOM.EQ.'6')ICOMI=6
      IF(ICOM.EQ.'7')ICOMI=7
      IF(ICOM.EQ.'8')ICOMI=8
      IF(ICOM.EQ.'9')ICOMI=9
      IF(ICOM.EQ.'10')ICOMI=10
      IF(ICOM.EQ.'11')ICOMI=11
      IF(ICOM.EQ.'12')ICOMI=12
      IF(ICOM.EQ.'13')ICOMI=13
      IF(ICOM.EQ.'14')ICOMI=14
      IF(ICOM.EQ.'15')ICOMI=15
      IF(ICOM.EQ.'16')ICOMI=16
      IF(ICOM.EQ.'17')ICOMI=17
      IF(ICOM.EQ.'18')ICOMI=18
      IF(ICOM.EQ.'19')ICOMI=19
      IF(ICOM.EQ.'20')ICOMI=20
      IF(ICOM.EQ.'    ')ICOM='UP'
      IF(ICOM.EQ.'U')ICOM='UP'
      IF(ICOM.EQ.'u')ICOM='UP'
      IF(ICOM.EQ.'up')ICOM='UP'
      IF(ICOM.EQ.'UP')ICOMT='WORD'
      IF(ICOM.EQ.'UP')GOTO2280
      IF(ICOM.EQ.'EXIT')GOTO2280
      GOTO50
C
 2280 CONTINUE
CCCCC CALL WISEWI(2)
      CALL WNSEL(2)
CCCCC CALL WICLWI('ON  ','OFF ')
CCCCC CALL WNCLOS('ON  ','OFF ')
      CALL WNCLOS(0)
CCCCC CALL WIEXWS('ON  ')
      CALL SHQUIT('ON  ')
      ICURWI=ICURWI-1
      GOTO9000
C
 2290 CONTINUE
      GOTO9000
C
C               ****************************************
C               **  STEP 23--                         **
C               **  READ THE MENU   FILE              **
C               **  AND WRITE (TO THE SCREEN) A MENU  **
C               ****************************************
C
 2300 CONTINUE
      ISTEPN='23'
      IF(IBUGME.EQ.'ON'.OR.ISUBRO.EQ.'MENU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG2(1).EQ.'PLOT')GOTO2331
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG(2).EQ.'FILE')GOTO2332
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG(2).EQ.'SETS')GOTO2332
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DATA'.AND.
     1IHARG(2).EQ.'ANAL')GOTO2340
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'GRAP')GOTO2339
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'MATH')GOTO2344
C
      IF(IMENSW.EQ.'TOP'.AND.NUMARG.GE.1.AND.
     1IARGT(1).EQ.'NUMB')GOTO2310
C
      IF(IMENSW.EQ.'TOP'.AND.NUMARG.EQ.0.AND.
     1ICOMT.EQ.'NUMB')GOTO2320
C
      GOTO2390
C
 2310 CONTINUE
      IF(IARG(1).EQ.1)GOTO2331
      IF(IARG(1).EQ.2)GOTO2332
      IF(IARG(1).EQ.3)GOTO2333
      IF(IARG(1).EQ.4)GOTO2334
      IF(IARG(1).EQ.5)GOTO2335
      IF(IARG(1).EQ.6)GOTO2336
      IF(IARG(1).EQ.7)GOTO2337
      IF(IARG(1).EQ.8)GOTO2338
      IF(IARG(1).EQ.9)GOTO2339
      IF(IARG(1).EQ.10)GOTO2340
      IF(IARG(1).EQ.11)GOTO2341
      IF(IARG(1).EQ.12)GOTO2342
      IF(IARG(1).EQ.13)GOTO2343
      IF(IARG(1).EQ.14)GOTO2344
      IF(IARG(1).EQ.15)GOTO2345
      IF(IARG(1).EQ.16)GOTO2346
      IF(IARG(1).EQ.17)GOTO2347
      IF(IARG(1).EQ.18)GOTO2348
      GOTO2390
C
 2320 CONTINUE
      IF(ICOMI.EQ.1)GOTO2331
      IF(ICOMI.EQ.2)GOTO2332
      IF(ICOMI.EQ.3)GOTO2333
      IF(ICOMI.EQ.4)GOTO2334
      IF(ICOMI.EQ.5)GOTO2335
      IF(ICOMI.EQ.6)GOTO2336
      IF(ICOMI.EQ.7)GOTO2337
      IF(ICOMI.EQ.8)GOTO2338
      IF(ICOMI.EQ.9)GOTO2339
      IF(ICOMI.EQ.10)GOTO2340
      IF(ICOMI.EQ.11)GOTO2341
      IF(ICOMI.EQ.12)GOTO2342
      IF(ICOMI.EQ.13)GOTO2343
      IF(ICOMI.EQ.14)GOTO2344
      IF(ICOMI.EQ.15)GOTO2345
      IF(ICOMI.EQ.16)GOTO2346
      IF(ICOMI.EQ.17)GOTO2347
      IF(ICOMI.EQ.18)GOTO2348
      GOTO2390
C
 2331 CONTINUE
      IMENSW='DP'
CCCCC IMENCO='0           '
      GOTO2390
C
 2332 CONTINUE
      IMENSW='DATA'
CCCCC IMENCO='0           '
      GOTO2390
C
 2333 CONTINUE
      IMENSW='COMM'
CCCCC IMENCO='0           '
      GOTO2390
C
 2334 CONTINUE
      IMENSW='FUNC'
CCCCC IMENCO='0           '
      GOTO2390
C
 2335 CONTINUE
      IMENSW='TEXT'
CCCCC IMENCO='0           '
      GOTO2390
C
 2336 CONTINUE
      IMENSW='DEXT'
CCCCC IMENCO='0           '
      GOTO2390
C
 2337 CONTINUE
      IMENSW='I/O'
CCCCC IMENCO='0           '
      GOTO2390
C
 2338 CONTINUE
      IMENSW='TUTO'
CCCCC IMENCO='0           '
      GOTO2390
C
 2339 CONTINUE
      IMENSW='GRAP'
CCCCC IMENCO='0           '
      GOTO2390
C
 2340 CONTINUE
      IMENSW='STAC'
CCCCC IMENCO='0           '
      GOTO2390
C
 2341 CONTINUE
      IMENSW='STAI'
CCCCC IMENCO='0           '
      GOTO2390
C
 2342 CONTINUE
      IMENSW='DEXP'
CCCCC IMENCO='0           '
      GOTO2390
C
 2343 CONTINUE
      IMENSW='PROB'
CCCCC IMENCO='0           '
      GOTO2390
C
 2344 CONTINUE
      IMENSW='MATH'
CCCCC IMENCO='0           '
      GOTO2390
C
 2345 CONTINUE
      IMENSW='SCIE'
CCCCC IMENCO='0           '
      GOTO2390
C
 2346 CONTINUE
      IMENSW='ENGI'
CCCCC IMENCO='0           '
      GOTO2390
C
 2347 CONTINUE
      IMENSW='BUSI'
CCCCC IMENCO='0           '
      GOTO2390
C
 2348 CONTINUE
      IMENSW='MISC'
CCCCC IMENCO='0           '
      GOTO2390
C
 2390 CONTINUE
C
CCCCC THE IHELMX LINE WAS ADDED TO FOLLOWING ARGUMENT LIST AUGUST 1990
      CALL DPMEN2(ICOM,ICOM2,ICOMT,ICOMI,
     1IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IMENSW,
     1IMENCO,IMENAL,
     1IHELMX,ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IANS,IWIDTH,IBUGM2,ISUBRO,IFOUND,IERROR)
C
      IF(IMENSW.EQ.'DP')IME1CO=IMENCO
      IF(IMENSW.EQ.'DATA')IME2CO=IMENCO
      IF(IMENSW.EQ.'COMM')IME3CO=IMENCO
      IF(IMENSW.EQ.'FUNC')IME4CO=IMENCO
      IF(IMENSW.EQ.'TEXT')IME5CO=IMENCO
      IF(IMENSW.EQ.'DEXT')IME6CO=IMENCO
      IF(IMENSW.EQ.'I/O')IME7CO=IMENCO
      IF(IMENSW.EQ.'TUTO')IME8CO=IMENCO
      IF(IMENSW.EQ.'GRAP')IME9CO=IMENCO
      IF(IMENSW.EQ.'STAC')IM10CO=IMENCO
      IF(IMENSW.EQ.'STAI')IM11CO=IMENCO
      IF(IMENSW.EQ.'DEXP')IM12CO=IMENCO
      IF(IMENSW.EQ.'PROB')IM13CO=IMENCO
      IF(IMENSW.EQ.'MATH')IM14CO=IMENCO
      IF(IMENSW.EQ.'SCIE')IM15CO=IMENCO
      IF(IMENSW.EQ.'ENGI')IM16CO=IMENCO
      IF(IMENSW.EQ.'BUSI')IM17CO=IMENCO
      IF(IMENSW.EQ.'MISC')IM18CO=IMENCO
C
      IF(IWINSY.EQ.'NONE')GOTO9000
      GOTO50
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGME.EQ.'OFF'.AND.ISUBRO.NE.'MENU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMENU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMENSW
 9012 FORMAT('IMENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IME1CO,IME1AL
 9031 FORMAT('IME1CO,IME1AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IME2CO,IME2AL
 9032 FORMAT('IME2CO,IME2AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IME3CO,IME3AL
 9033 FORMAT('IME3CO,IME3AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IME4CO,IME4AL
 9034 FORMAT('IME4CO,IME4AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IME5CO,IME5AL
 9035 FORMAT('IME5CO,IME5AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IME6CO,IME6AL
 9036 FORMAT('IME6CO,IME6AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)IME7CO,IME7AL
 9037 FORMAT('IME7CO,IME7AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IME8CO,IME8AL
 9038 FORMAT('IME8CO,IME8AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IME9CO,IME9AL
 9039 FORMAT('IME9CO,IME9AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)IM10CO,IM10AL
 9040 FORMAT('IM10CO,IM10AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IM11CO,IM11AL
 9041 FORMAT('IM11CO,IM11AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IM12CO,IM12AL
 9042 FORMAT('IM12CO,IM12AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IM13CO,IM13AL
 9043 FORMAT('IM13CO,IM13AL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9048)IMENCO,IMENAL
 9048 FORMAT('IMENCO,IMENAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IBUGME,IBUGM2,IFOUND,IERROR
 9049 FORMAT('IBUGME,IBUGM2,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMEN2(ICOM,ICOM2,ICOMT,ICOMI,
     1IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IMENSW,
     1IMENCO,IMENAL,
     1IHELMX,ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IANS,IWIDTH,IBUGM2,ISUBRO,IFOUND,IERROR)
CCCCC THE THIRD LINE OF THE ARGUMENT LIST WAS ADDED AUGUST 1990
C
C     PURPOSE--READ THE DESIGNATED MENU
C              FROM (ONE OF) DATAPLOT'S MENU   SUB-SYSTEM FILE(S),
C              AND WRITE THE MENU OUT TO SCREEN.
C     INPUT  ARGUMENTS--IMENSW (A HOLLARITH VARIABLE
C                       IDENTIFYING WHICH SUB-SYSTEM.
C                     --IMENCO (A HOLLARITH VARIABLE
C                       CONTAINING A MENU IDENTIFICATION STRING.
C                     --IMENAL (A HOLLARITH VARIABLE (ON/OFF)
C                       CONTAINING A SWITCH SETTING AS TO WHETHER
C                       ALL OF THE TOPIC MENU SHOULD BE PRINTED OUT.
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--90/7
C     ORIGINAL VERSION--JUNE      1990.
C     UPDATED         --AUGUST    1990. MENU 11 TO 20
C     UPDATED         --AUGUST    1990. NEW INPUT ARGUMENTS
C     UPDATED         --AUGUST    1990. NEW MENU
C     UPDATED         --AUGUST    1990. MORE/PAUSE WITH MENU
C     UPDATED         --AUGUST    1990.  EXPLICIT SETTING OF NUMLPR=0
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICOMT
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IMENSW
      CHARACTER*12 IMENCO
      CHARACTER*4 IMENAL
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
      CHARACTER*4 IANS
      CHARACTER*4 IBUGM2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
C
      CHARACTER*12 ITABID
C
      CHARACTER*80 ICTEXT
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 ICJUNK
C
      CHARACTER*12 ICID
      CHARACTER*80 ISTRIN
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      CHARACTER*4 IRESP
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ITABID(500)
      DIMENSION ITABLN(500)
C
      DIMENSION IANS(*)
C
C-----COMMON----------------------------------------------------------
C
CCCCC INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOWI.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      NUMSEC=(-999)
      JSEC=(-999)
      ISKIP=(-999)
      ISTART=(-999)
      I2=(-999)
C
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPME'
      ISUBN2='N2  '
C
      IF(IBUGM2.EQ.'OFF'.AND.ISUBRO.NE.'MEN2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMEN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMENSW
   52 FORMAT('IMENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMENCO,IMENAL
   53 FORMAT('IMENCO,IMENAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGM2,ISUBRO,IERROR
   55 FORMAT('IBUGM2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IHELMX
   61 FORMAT('IHELMX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)NCPREH
   62 FORMAT('NCPREH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPREH.LE.0)GOTO65
      DO63I=1,NCPREH
      WRITE(ICOUT,64)I,ICPREH(I:I)
   64 FORMAT('I,ICPREH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
   65 CONTINUE
      WRITE(ICOUT,66)NCPOSH
   66 FORMAT('NCPOSH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCPOSH.LE.0)GOTO69
      DO67I=1,NCPOSH
      WRITE(ICOUT,68)I,ICPOSH(I:I)
   68 FORMAT('I,ICPOSH(I:I) = ',I8,2X,A1,4X)
      CALL DPWRST('XXX','BUG ')
   67 CONTINUE
   69 CONTINUE
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      IF(IMENSW.EQ.'TOP')GOTO1110
      IF(IMENSW.EQ.'DP')GOTO1110
      IF(IMENSW.EQ.'DATA')GOTO1120
      IF(IMENSW.EQ.'COMM')GOTO1130
      IF(IMENSW.EQ.'FUNC')GOTO1140
      IF(IMENSW.EQ.'TEXT')GOTO1150
      IF(IMENSW.EQ.'DEXT')GOTO1160
      IF(IMENSW.EQ.'I/O')GOTO1170
      IF(IMENSW.EQ.'TUTO')GOTO1180
      IF(IMENSW.EQ.'GRAP')GOTO1190
      IF(IMENSW.EQ.'STAC')GOTO1200
      IF(IMENSW.EQ.'STAI')GOTO1210
      IF(IMENSW.EQ.'DEXP')GOTO1220
      IF(IMENSW.EQ.'PROB')GOTO1230
      IF(IMENSW.EQ.'MATH')GOTO1240
      IF(IMENSW.EQ.'SCIE')GOTO1250
      IF(IMENSW.EQ.'ENGI')GOTO1260
      IF(IMENSW.EQ.'BUSI')GOTO1270
      IF(IMENSW.EQ.'MISC')GOTO1280
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** INTERNAL ERROR IN DPMEN2 ',
     1'AT BRANCH POINT 1101--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)
 1102 FORMAT('      IMENSW SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)
 1103 FORMAT('      TOP, DP, DATA, COMM, I/O, GRAP, STAC, ETC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1105)
 1105 FORMAT('      BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1106)IMENSW
 1106 FORMAT('      IMENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IOUNIT=IME1NU
      IFILE=IME1NA
      ISTAT=IME1ST
      IFORM=IME1FO
      IACCES=IME1AC
      IPROT=IME1PR
      ICURST=IME1CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1120 CONTINUE
      IOUNIT=IME2NU
      IFILE=IME2NA
      ISTAT=IME2ST
      IFORM=IME2FO
      IACCES=IME2AC
      IPROT=IME2PR
      ICURST=IME2CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1130 CONTINUE
      IOUNIT=IME3NU
      IFILE=IME3NA
      ISTAT=IME3ST
      IFORM=IME3FO
      IACCES=IME3AC
      IPROT=IME3PR
      ICURST=IME3CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1140 CONTINUE
      IOUNIT=IME4NU
      IFILE=IME4NA
      ISTAT=IME4ST
      IFORM=IME4FO
      IACCES=IME4AC
      IPROT=IME4PR
      ICURST=IME4CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1150 CONTINUE
      IOUNIT=IME5NU
      IFILE=IME5NA
      ISTAT=IME5ST
      IFORM=IME5FO
      IACCES=IME5AC
      IPROT=IME5PR
      ICURST=IME5CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1160 CONTINUE
      IOUNIT=IME6NU
      IFILE=IME6NA
      ISTAT=IME6ST
      IFORM=IME6FO
      IACCES=IME6AC
      IPROT=IME6PR
      ICURST=IME6CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1170 CONTINUE
      IOUNIT=IME7NU
      IFILE=IME7NA
      ISTAT=IME7ST
      IFORM=IME7FO
      IACCES=IME7AC
      IPROT=IME7PR
      ICURST=IME7CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1180 CONTINUE
      IOUNIT=IME8NU
      IFILE=IME8NA
      ISTAT=IME8ST
      IFORM=IME8FO
      IACCES=IME8AC
      IPROT=IME8PR
      ICURST=IME8CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1190 CONTINUE
      IOUNIT=IME9NU
      IFILE=IME9NA
      ISTAT=IME9ST
      IFORM=IME9FO
      IACCES=IME9AC
      IPROT=IME9PR
      ICURST=IME9CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1200 CONTINUE
      IOUNIT=IM10NU
      IFILE=IM10NA
      ISTAT=IM10ST
      IFORM=IM10FO
      IACCES=IM10AC
      IPROT=IM10PR
      ICURST=IM10CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1210 CONTINUE
      IOUNIT=IM11NU
      IFILE=IM11NA
      ISTAT=IM11ST
      IFORM=IM11FO
      IACCES=IM11AC
      IPROT=IM11PR
      ICURST=IM11CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1220 CONTINUE
      IOUNIT=IM12NU
      IFILE=IM12NA
      ISTAT=IM12ST
      IFORM=IM12FO
      IACCES=IM12AC
      IPROT=IM12PR
      ICURST=IM12CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1230 CONTINUE
      IOUNIT=IM13NU
      IFILE=IM13NA
      ISTAT=IM13ST
      IFORM=IM13FO
      IACCES=IM13AC
      IPROT=IM13PR
      ICURST=IM13CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1240 CONTINUE
      IOUNIT=IM14NU
      IFILE=IM14NA
      ISTAT=IM14ST
      IFORM=IM14FO
      IACCES=IM14AC
      IPROT=IM14PR
      ICURST=IM14CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1250 CONTINUE
      IOUNIT=IM15NU
      IFILE=IM15NA
      ISTAT=IM15ST
      IFORM=IM15FO
      IACCES=IM15AC
      IPROT=IM15PR
      ICURST=IM15CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1260 CONTINUE
      IOUNIT=IM16NU
      IFILE=IM16NA
      ISTAT=IM16ST
      IFORM=IM16FO
      IACCES=IM16AC
      IPROT=IM16PR
      ICURST=IM16CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1270 CONTINUE
      IOUNIT=IM17NU
      IFILE=IM17NA
      ISTAT=IM17ST
      IFORM=IM17FO
      IACCES=IM17AC
      IPROT=IM17PR
      ICURST=IM17CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1280 CONTINUE
      IOUNIT=IM18NU
      IFILE=IM18NA
      ISTAT=IM18ST
      IFORM=IM18FO
      IACCES=IM18AC
      IPROT=IM18PR
      ICURST=IM18CS
      ISUBN0='MEN2'
      IERRFI='NO'
      GOTO1290
C
 1290 CONTINUE
      IF(IBUGM2.EQ.'OFF'.AND.ISUBRO.NE.'MEN2')GOTO1299
      WRITE(ICOUT,1293)IOUNIT
 1293 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)IFILE
 1294 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1295)ISTAT,IFORM,IACCES,IPROT,ICURST
 1295 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1296)IBUGM2,ISUBRO,ISUBN0,IERRFI
 1296 FORMAT('IBUGM2,ISUBRO,ISUBN0,IERRFI = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1299 CONTINUE
C
C               ***********************************************
C               **  STEP 13--                                **
C               **  CHECK TO SEE IF THIS MENU   FILE EXISTS  **
C               ***********************************************
C
      ISTEPN='13'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1300
      GOTO1390
 1300 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPMEN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE MENU   SUB-SYSTEM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      CANNOT BE ENTERED FOR THIS TOPIC BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      WHICH STORES MENU   MENUS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('      IS NOT YET AVAILABLE FOR THIS TOPIC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)ISTAT,IMENSW
 1317 FORMAT('ISTAT,IMENSW = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1390 CONTINUE
C
C               *********************
C               **  STEP 20--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='20'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGM2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ************************************************************
C               **  STEP 41--                                             **
C               **  READ IN FILE INFORMATION                              **
C               **  FROM THE BEGINNING LINES OF THE FILE.                 **
C               **  THESE LEAD LINES CONTAIN                              **
C               **  THE IDENTIFIER          FOR EACH SECTION              **
C               **  IN THE FILE (ITABID(.) (A12 FORMAT).                  **
C               **  THE STARTING BASE LINE NUMBER OF EACH SECTION              *
C               **  IN THE FILE (ITABLN)   (I8 FORMAT), AND            **
C               **  THE STARTING INCREMENT LINE NUMBER OF EACH SECTION
C               **  IN THE FILE (ITABDE)   (I10 FORMAT), AND            **
C               ************************************************************
C
 
      READ(IOUNIT,4110,END=4180)ICJUNK
 4110 FORMAT(A1)
      READ(IOUNIT,4110,END=4180)ICJUNK
C
      NUMSEC=0
      DO4120I=1,100000
      READ(IOUNIT,4121,END=4180)ITABID(I),ITABBA,ITABDE
 4121 FORMAT(A12,I8,I10)
      READ(IOUNIT,4122,END=4180)ICJUNK
 4122 FORMAT(A1)
      IF(ITABID(I).EQ.'            ')GOTO4129
      NUMSEC=NUMSEC+1
      ITABLN(I)=ITABBA+ITABDE
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1WRITE(ICOUT,4123)I,ITABID(I),ITABBA,ITABDE,ITABLN(I)
 4123 FORMAT('I,ITABID(I),ITABBA,ITABDE,ITABLN(I)=',I8,2X,A12,3I8)
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4129 CONTINUE
      ANUMSE=NUMSEC
      GOTO4190
C
 4180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4181)
 4181 FORMAT('***** INTERNAL ERROR IN DPMEN2 ',
     1'AT BRANCH POINT 4181--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4182)
 4182 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4183)
 4183 FORMAT('      WHILE READING THE LOOK-UP TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4184)
 4184 FORMAT('      WITHIN A DATAPLOT MENU   SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4185)IFILE
 4185 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4190 CONTINUE
C
C               *******************************************************
C               **  STEP 42--                                        **
C               **  BASED ON THE CODE STRING IN IMENCO               **
C               **  DO A TABLE LOOK-UP WHICH WILL SPECIFY            **
C               **  THE ABSOLUTE LINE NUMBER IN THE FILE             **
C               **  WHERE THE SECTION WITH THAT CODE WORD STARTS     **
C               *******************************************************
C
      ISTEPN='42'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4200I=1,NUMSEC
      I2=I
      IF(IMENCO.EQ.ITABID(I))GOTO4210
 4200 CONTINUE
      JSEC=1
 4210 CONTINUE
      JSEC=I2
C
      ISTART=ITABLN(JSEC)
C
      IF(IBUGM2.EQ.'OFF'.AND.ISUBRO.NE.'MEN2')GOTO4290
      WRITE(ICOUT,4211)
 4211 FORMAT('***** FROM 4211 IN MIDDLE OF DPMEN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4213)JSEC,ISTART
 4213 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4290 CONTINUE
C
C               *************************************************
C               **  STEP 43--                                  **
C               **  READ DOWN IN THE FILE TO                   **
C               **  THE LINE BEFORE WHERE THE SECTION STARTS   **
C               *************************************************
C
      ISTEPN='43'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      REWIND(IOUNIT)
C
      MENWID=70
      ISKIP=ISTART-1
      IF(ISKIP.LE.0)GOTO4319
      READ(IOUNIT,4315,END=4380)
 4315 FORMAT()
      IF(ISKIP.LE.1)GOTO4319
      READ(IOUNIT,4316,END=4380)MENWID
 4316 FORMAT(I2)
      IF(MENWID.LE.0)MENWID=70
      IF(ISKIP.LE.2)GOTO4319
      IMAX=ISKIP-2
      DO4310I=1,IMAX
      READ(IOUNIT,4315,END=4380)
 4310 CONTINUE
 4319 CONTINUE
      GOTO4390
C
 4380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4381)
 4381 FORMAT('***** INTERNAL ERROR IN DPMEN2 ',
     1'AT BRANCH POINT 4381--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4382)
 4382 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4383)
 4383 FORMAT('      WHILE CARRYING OUT SKIPS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4384)
 4384 FORMAT('      WITHIN A DATAPLOT MENU   SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4385)IFILE
 4385 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4390 CONTINUE
C
C               ***************************************************
C               **  STEP 45--                                    **
C               **  FOR THIS TARGET SECTION--                    **
C               **     1) SKIP OVER 3 HEADER LINES               **
C               **        (---- AND BLANK AND ID)                **
C               **     2) READ IN (AND WRITE OUT) THE TEXT       **
C               **        FOR THE SECTION--                      **
C               **        (THIS IS WHAT THE ANALYST WILL SEE     **
C               **        ON THE SCREEN).                        **
C               **        THE LAST LINE OF THE TEXT IS           **
C               **        A LINE OF HYPHENS (THIS LINE IS        **
C               **        NOT PRINTED OUT).                      **
C               **     3) READ IN (AND STORE) THE NUMBER OF      **
C               **        MENU ITEMS THAT WERE OFFERED           **
C               **     4) READ IN (AND STORE) THE CODE WORD      **
C               **        (= SUBSEQUENT BRANCH POINT)            **
C               **        FOR EACH MENU ITEM                     **
C               ***************************************************
C
      ISTEPN='45'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      READ(IOUNIT,4501,END=4580)
 4501 FORMAT()
      READ(IOUNIT,4501,END=4580)
      READ(IOUNIT,4502,END=4580)ICID
 4502 FORMAT(A12)
C
CCCCC WRITE(ICOUT,4511)IESCC,IFFC
C4511 FORMAT(2A1)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,4512)IESCC
C4512 FORMAT(A1,'8')
CCCCC CALL DPWRST('XXX','BUG ')
C
CCCCC WRITE(ICOUT,4513)IMENCO
C4513 FORMAT(58X,A12)
CCCCC CALL DPWRST('XXX','BUG ')
C
C     ----------
C
      IF(IWINSY.EQ.'NONE')GOTO4509
      IF(IWINSY.EQ.'OTG')GOTO4504
      GOTO4509
C
 4504 CONTINUE
      IF(ICOM.EQ.'UP')GOTO4505
      ICURWI=ICURWI+1
CCCCC CALL WISEWI(ICURWI)
      CALL WNSEL(ICURWI)
      IX1=1+(ICURWI-2)*10
      IX2=80-MENWID+1
      IX=IX1
      IF(IX2.LT.IX1)IX=IX2
      IY=1
      IXLEN=80-IX+1
      IYLEN=20
      IF(ICURWI.EQ.2)IXLEN=40
CCCCC CALL WISECO('BLUE','WHIT')
      CALL COLOR('WHIT','BLUE')
CCCCC CALL WISETY('POP ')
CCCCC CALL WISEFR('ON  ')
      CALL WNACTN('FC')
CCCCC CALL WISELS(IX,IY,IXLEN,IYLEN)
CCCCC CALL WISEWR('OFF ')
      CALL WNWRAP('OFF ')
CCCCC CALL WIOPWI
      CALL WNOPEN(IX,IY,IXLEN,IYLEN)
 4505 CONTINUE
CCCCC CALL WIERWI
      CALL WNCLR
CCCCC CALL WIMOHO
      CALL WNHOME
      GOTO4509
C
 4509 CONTINUE
C
C     ----------
C
      IF(IWINSY.EQ.'NONE')GOTO4510
      IF(IWINSY.EQ.'OTG')GOTO4512
      GOTO4510
C
 4510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4511)ICID
 4511 FORMAT(A12,'---------------------------------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      GOTO4519
C
 4512 CONTINUE
      ISTRIN(1:12)=ICID(1:12)
CCCCC CALL WIMWST(1,1,ISTRIN,12)
      CALL WNOUSX(1,1,ISTRIN)
      GOTO4519
C
 4519 CONTINUE
C
C     ----------
C
      NUMLPR=3
      IRESP='YES'
      IPASS=1
      IPOS=NUMLPR
C
      DO4520I=1,100000
C
      READ(IOUNIT,4521,END=4580)ICTEXT
 4521 FORMAT(A80)
CCCCC IF(ICTEXT(1:5).EQ.'SSSSS')GOTO4590   DECEMBER 1986
CCCCC IF(ICTEXT(1:5).EQ.'EEEEE')GOTO4590   DECEMBER 1986
      IF(ICTEXT(1:5).EQ.'-----')GOTO4529
C
      DO4530J=1,80
      JREV=80-J+1
      IF(ICTEXT(JREV:JREV).NE.' ')GOTO4535
 4530 CONTINUE
      JREV=1
 4535 CONTINUE
C
      IF(IWINSY.EQ.'NONE')GOTO4536
      IF(IWINSY.EQ.'OTG')GOTO4538
      GOTO4536
C
 4536 CONTINUE
      IF(JREV.LE.0)WRITE(ICOUT,999)
      IF(JREV.LE.0)CALL DPWRST('XXX','BUG ')
      IF(JREV.GE.1)WRITE(ICOUT,4537)(ICTEXT(K:K),K=1,JREV)
 4537 FORMAT(80A1)
      IF(JREV.GE.1)CALL DPWRST('XXX','BUG ')
      GOTO4539
C
 4538 CONTINUE
      IPOS=NUMLPR
      IF(IPASS.GE.2)IPOS=NUMLPR+1
      IF(JREV.LE.0)ISTRIN=' '
CCCCC IF(JREV.LE.0)CALL WIMWST(1,IPOS,ISTRIN,1)
      IF(JREV.LE.0)CALL WNOUSX(1,IPOS,ISTRIN)
CCCCC IF(JREV.GE.1)CALL WIMWST(1,IPOS,ICTEXT,JREV)
      IF(JREV.GE.1)CALL WNOUSX(1,IPOS,ICTEXT)
      GOTO4539
C
 4539 CONTINUE
      NUMLPR=NUMLPR+1
C
      IF(NUMLPR.GE.IHELMX)GOTO4540
      IF(IRESP(1:1).EQ.'N')GOTO4529
      IF(IRESP(1:1).EQ.'n')GOTO4529
      GOTO4520
C
 4540 CONTINUE
      IPASS=IPASS+1
      IF(IWINSY.EQ.'NONE')GOTO4541
      IF(IWINSY.EQ.'OTG')GOTO4542
      GOTO4541
C
 4541 CONTINUE
      CALL DPMORE(NUMLPR,NCPREH,ICPREH,IRESP,IBUGM2,IERROR)
      IF(NUMLPR.GE.IHELMX)NUMLPR=0
      IF(IRESP.EQ.'NO')GOTO4529
      GOTO4520
C
 4542 CONTINUE
CCCCC CALL WISEWI(1)
      CALL WNSEL(1)
CCCCC CALL WIERWI
      CALL WNCLR
      ISTRIN='MORE (Y,N)...?>'
CCCCC CALL WIMWST(1,1,ISTRIN,15)
      CALL WNOUSX(1,1,ISTRIN)
CCCCC CALL WIREST(ISTRIN,LENGTH)
      CALL INSTR(ISTRIN,LENGTH)
      IRESP(1:4)=ISTRIN(1:4)
      IF(NUMLPR.GE.IHELMX)NUMLPR=0
      IF(IRESP(1:1).EQ.'N')IRESP='NO  '
      IF(IRESP(1:1).EQ.'n')IRESP='NO  '
      IF(IRESP(1:1).EQ.'Y')IRESP='YES '
      IF(IRESP(1:1).EQ.'y')IRESP='YES '
      IF(IRESP.EQ.'NO')GOTO4529
      IF(IRESP.EQ.'YES')GOTO4545
      GOTO4565
C
 4545 CONTINUE
CCCCC CALL WISEWI(ICURWI)
      CALL WNSEL(ICURWI)
CCCCC CALL WIERWI
      CALL WNCLR
CCCCC CALL WIMOHO
      CALL WNHOME
      GOTO4520
C
 4520 CONTINUE
 4529 CONTINUE
C
C     ----------
C
      IF(IWINSY.EQ.'NONE')GOTO4555
      IF(IWINSY.EQ.'OTG')GOTO4560
      GOTO4555
C
 4555 CONTINUE
      IF(NCPOSH.LE.0)GOTO4559
      WRITE(ICOUT,4556)(ICPOSH(J:J),J=1,NCPOSH)
 4556 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
 4559 CONTINUE
      GOTO4590
C
 4560 CONTINUE
CCCCC CALL WISEWI(1)
      CALL WNSEL(1)
CCCCC CALL WIERWI
      CALL WNCLR
      ISTRIN='>'
CCCCC CALL WIMWST(1,1,ISTRIN,1)
      CALL WNOUSX(1,1,ISTRIN)
CCCCC CALL WIREST(ISTRIN,LENGTH)
      CALL INSTR(ISTRIN,LENGTH)
      IRESP(1:4)=ISTRIN(1:4)
CCCCC CAUTION--THE FOLLOWING LINE REDEFINES THE INPUT VARIABLE ICOM
 4565 CONTINUE
      ICOM=IRESP
      NUMARG=0
      ICOM2='    '
      ICOMT='NUMB'
      ICOMI=0
      IF(ICOM.EQ.'1')ICOMI=1
      IF(ICOM.EQ.'2')ICOMI=2
      IF(ICOM.EQ.'3')ICOMI=3
      IF(ICOM.EQ.'4')ICOMI=4
      IF(ICOM.EQ.'5')ICOMI=5
      IF(ICOM.EQ.'6')ICOMI=6
      IF(ICOM.EQ.'7')ICOMI=7
      IF(ICOM.EQ.'8')ICOMI=8
      IF(ICOM.EQ.'9')ICOMI=9
      IF(ICOM.EQ.'10')ICOMI=10
      IF(ICOM.EQ.'11')ICOMI=11
      IF(ICOM.EQ.'12')ICOMI=12
      IF(ICOM.EQ.'13')ICOMI=13
      IF(ICOM.EQ.'14')ICOMI=14
      IF(ICOM.EQ.'15')ICOMI=15
      IF(ICOM.EQ.'16')ICOMI=16
      IF(ICOM.EQ.'17')ICOMI=17
      IF(ICOM.EQ.'18')ICOMI=18
      IF(ICOM.EQ.'19')ICOMI=19
      IF(ICOM.EQ.'20')ICOMI=20
      IF(ICOM.EQ.'21')ICOMI=21
      IF(ICOM.EQ.'22')ICOMI=22
      IF(ICOM.EQ.'23')ICOMI=23
      IF(ICOM.EQ.'24')ICOMI=24
      IF(ICOM.EQ.'25')ICOMI=25
      IF(ICOM.EQ.'26')ICOMI=26
      IF(ICOM.EQ.'27')ICOMI=27
      IF(ICOM.EQ.'28')ICOMI=28
      IF(ICOM.EQ.'29')ICOMI=29
      IF(ICOM.EQ.'30')ICOMI=30
      IF(ICOM.EQ.'    ')ICOM='UP'
      IF(ICOM.EQ.'U')ICOM='UP'
      IF(ICOM.EQ.'u')ICOM='UP'
      IF(ICOM.EQ.'up')ICOM='UP'
      IF(ICOM.EQ.'UP')ICOMT='WORD'
      IF(ICOM.EQ.'UP')GOTO4570
      IF(ICOM.EQ.'EXIT')GOTO4575
      GOTO4590
C
 4570 CONTINUE
CCCCC CALL WISEWI(ICURWI)
      CALL WNSEL(ICURWI)
CCCCC CALL WICLWI('ON  ','OFF ')
CCCCC CALL WNCLOS('ON  ','OFF ')
      CALL WNCLOS(0)
CCCCC IF(ICURWI.LE.2)CALL WIEXWS('ON  ')
      IF(ICURWI.LE.2)CALL SHQUIT('ON  ')
      ICURWI=ICURWI-1
      GOTO4590
C
 4575 CONTINUE
      DO4576I=1,100
CCCCC CALL WISEWI(ICURWI)
      CALL WNSEL(ICURWI)
CCCCC CALL WICLWI('ON  ','OFF ')
CCCCC CALL WNCLOS('ON  ','OFF ')
      CALL WNCLOS(0)
      ICURWI=ICURWI-1
      IF(ICURWI.LE.0)GOTO4577
 4576 CONTINUE
 4577 CONTINUE
CCCCC CALL WIEXWS('ON  ')
      CALL SHQUIT('ON  ')
      GOTO4590
C
C     ----------
C
 4580 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4581)
 4581 FORMAT('***** INTERNAL ERROR IN DPMEN2 ',
     1'AT BRANCH POINT 4581--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4582)
 4582 FORMAT('      AN UNEXPECTED END OF FILE WAS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4583)
 4583 FORMAT('      WHILE READING WITHIN THE TARGET SECTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4584)
 4584 FORMAT('      WITHIN A DATAPLOT MENU   SUB-SYSTEM FILE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4585)IFILE
 4585 FORMAT('      IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4586)JSEC,ISTART
 4586 FORMAT('JSEC,ISTART = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO5000
 4589 CONTINUE
C
 4590 CONTINUE
C
C               **************************************
C               **  STEP 50--                       **
C               **  CLOSE        THIS MENU   FILE.  **
C               **************************************
C
 5000 CONTINUE
C
      ISTEPN='50'
      IF(IBUGM2.EQ.'ON'.OR.ISUBRO.EQ.'MEN2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGM2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGM2.EQ.'OFF'.AND.ISUBRO.NE.'MEN2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMEN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGM2,ISUBRO,IERROR
 9012 FORMAT('IBUGM2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ISKIP,ISTART,I2
 9051 FORMAT('ISKIP,ISTART,I2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IMENSW
 9052 FORMAT('IMENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)IMENCO,IMENAL
 9054 FORMAT('IMENCO,IMENAL = ',A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)NUMSEC
 9061 FORMAT('NUMSEC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)JSEC,ITABLN(JSEC),ITABID(JSEC)
 9062 FORMAT('JSEC,ITABLN(JSEC),ITABID(JSEC) = ',2I8,2X,A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMEP2(Y,F1,F2,F3,F4,F5,W,N,NUMFAC,
     1B,SDB,FCUM,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1Y2,Z,
     1IBUGA3,IERROR)
CCCCC JUNE, 1990.  MOVE DIMENSIONING OF Y2 AND Z TO DPMEPO.
C
C     PURPOSE--DO A MULTI-WAY MEDIAN POLISH
C              FOR 1, 2, 3, 4, OR 5 FACTORS.
C              THE ASSUMED MODEL IS RESPONSE = CONSTANT + FACTOR-1 EFFECT + ...
C                                              FACTOR-NUMFAC EFFECT + ERROR
C     NOTE-- LINES NEAR 390 NEEDS TO BE GENERALIZED FOR
C     UNEQUAL NUMBER OF OBS PER CELL.
C     PRINTING--YES
C     SUBROUTINES NEEDED--FCDF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.  ADD LOFCDF
C     UPDATED         --JUNE      1990.  MOVE DIMENSIONING OF Y2 AND Z
C     UPDATED         --JANUARY   1996.  MAKE MAXIMUM NUMBER OF LEVELS
C                                        SETTABLE VIA PARAMETER
C                                        STATEMENT (AND PUT IN CHECKS
C                                        FOR EXCEEDING THIS MAXIMUM)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IREP
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
CCCCC JUNE, 1990.  MOVE DIMENSIONING OF Y2 AND Z TO DPMEPO
CCCCC       INCLUDE 'DPCOPA.INC'
C
CCCCC DIMENSION Y2(MAXOBV)
      DIMENSION Y2(*)
C
      DIMENSION Y(*)
C
      DIMENSION F1(*)
      DIMENSION F2(*)
      DIMENSION F3(*)
      DIMENSION F4(*)
      DIMENSION F5(*)
C
      DIMENSION W(*)
C
      DIMENSION B(*)
      DIMENSION SDB(*)
      DIMENSION FCUM(*)
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
CCCCC JANUARY 1996.  MAKE DIMENSION STATEMENTS DEPEND ON A PARAMETER
CCCCC STATEMENT (SO THAT THEY CAN BE EASILY UPDATED IF NEEDED).
      PARAMETER (MAXLEV=500)
CCCCC DIMENSION F1ID(100)
CCCCC DIMENSION F2ID(100)
CCCCC DIMENSION F3ID(100)
CCCCC DIMENSION F4ID(100)
CCCCC DIMENSION F5ID(100)
      DIMENSION F1ID(MAXLEV)
      DIMENSION F2ID(MAXLEV)
      DIMENSION F3ID(MAXLEV)
      DIMENSION F4ID(MAXLEV)
      DIMENSION F5ID(MAXLEV)
C
CCCCC DIMENSION F1N(100)
CCCCC DIMENSION F2N(100)
CCCCC DIMENSION F3N(100)
CCCCC DIMENSION F4N(100)
CCCCC DIMENSION F5N(100)
      DIMENSION F1N(MAXLEV)
      DIMENSION F2N(MAXLEV)
      DIMENSION F3N(MAXLEV)
      DIMENSION F4N(MAXLEV)
      DIMENSION F5N(MAXLEV)
C
CCCCC DIMENSION F1TYP(100)
CCCCC DIMENSION F2TYP(100)
CCCCC DIMENSION F3TYP(100)
CCCCC DIMENSION F4TYP(100)
CCCCC DIMENSION F5TYP(100)
      DIMENSION F1TYP(MAXLEV)
      DIMENSION F2TYP(MAXLEV)
      DIMENSION F3TYP(MAXLEV)
      DIMENSION F4TYP(MAXLEV)
      DIMENSION F5TYP(MAXLEV)
C
CCCC  DIMENSION F1EFFE(100)
CCCC  DIMENSION F2EFFE(100)
CCCC  DIMENSION F3EFFE(100)
CCCC  DIMENSION F4EFFE(100)
CCCC  DIMENSION F5EFFE(100)
      DIMENSION F1EFFE(MAXLEV)
      DIMENSION F2EFFE(MAXLEV)
      DIMENSION F3EFFE(MAXLEV)
      DIMENSION F4EFFE(MAXLEV)
      DIMENSION F5EFFE(MAXLEV)
C
CCCCC DIMENSION F1EFSD(100)
CCCCC DIMENSION F2EFSD(100)
CCCCC DIMENSION F3EFSD(100)
CCCCC DIMENSION F4EFSD(100)
CCCCC DIMENSION F5EFSD(100)
      DIMENSION F1EFSD(MAXLEV)
      DIMENSION F2EFSD(MAXLEV)
      DIMENSION F3EFSD(MAXLEV)
      DIMENSION F4EFSD(MAXLEV)
      DIMENSION F5EFSD(MAXLEV)
C
CCCCC DIMENSION CELLN(MAXOBV)
CCCCC DIMENSION CELLME(MAXOBV)
CCCCC DIMENSION CELLSD(MAXOBV)
      DIMENSION FVAL(10)
      DIMENSION RSD(10)
CCCCC DIMENSION Z(MAXOBV)
      DIMENSION Z(*)
C
      DIMENSION Y2MED(100)
C
C---------------------------------------------------------------------
C
CCCCC EQUIVALENCE (Y2(1),CELLME(1))
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPAN'
      ISUBN2='O2  '
C
      MAXFAC=5
      AN=N
C
      MAXPAS=25
      IWRITE='OFF'
      CUTOFF=0.99
C
      GTYP=0.0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NUMFAC
   52 FORMAT('N,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I)
   56 FORMAT('I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I) = ',
     1I8,7E11.3)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('***** ERROR IN DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)
  102 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
     1'MEDIAN POLISH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)
  103 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)N
  104 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  109 CONTINUE
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,116)
  116 FORMAT('***** ERROR IN DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,117)
  117 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ',
     1'MEDIAN POLISH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,118)
  118 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(NUMFAC.GE.1.AND.NUMFAC.LE.MAXFAC)GOTO139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)
  131 FORMAT('***** ERROR IN DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,132)
  132 FORMAT('      THE NUMBER OF FACTORS FOR THE MEDIAN POLISH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,133)MAXFAC
  133 FORMAT('      MUST BE AT LEAST 1 AND AT MOST ',I6,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,134)NUMFAC
  134 FORMAT('      THE ENTERED NUMBER OF FACTORS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  139 CONTINUE
C
      HOLD=Y(1)
      DO140I=1,N
      IF(Y(I).NE.HOLD)GOTO149
  140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)
  141 FORMAT('***** ERROR IN DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,142)
  142 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS FOR THE ',
     1'MEDIAN POLISH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,143)HOLD
  143 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  149 CONTINUE
C
      DO150J=1,NUMFAC
      IF(J.EQ.1)HOLD=F1(1)
      IF(J.EQ.2)HOLD=F2(1)
      IF(J.EQ.3)HOLD=F3(1)
      IF(J.EQ.4)HOLD=F4(1)
      IF(J.EQ.5)HOLD=F5(1)
      DO155I=1,N
      IF(J.EQ.1)HOLD2=F1(I)
      IF(J.EQ.2)HOLD2=F2(I)
      IF(J.EQ.3)HOLD2=F3(I)
      IF(J.EQ.4)HOLD2=F4(I)
      IF(J.EQ.5)HOLD2=F5(I)
      IF(HOLD2.NE.HOLD)GOTO150
  155 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,151)
  151 FORMAT('***** DIAGNOSTIC NOTE FROM DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,152)J
  152 FORMAT('      ALL ELEMENTS OF FACTOR ',I5,' IN THE ',
     1'MEDIAN POLISH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,153)HOLD
  153 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  150 CONTINUE
C
C               ***********************************************
C               **  STEP 1.1--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR FACTOR 1                             **
C               ***********************************************
C
CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      N1=0
      DO160I=1,N
      IF(N1.LE.0)GOTO180
      DO170J=1,N1
      IF(F1(I).EQ.F1ID(J))GOTO160
  170 CONTINUE
  180 CONTINUE
      N1=N1+1
      IF(N1.GT.MAXLEV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,190)MAXLEV
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
  190 FORMAT('***** ERROR IN DPMEP2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR 1')
      F1ID(N1)=F1(I)
  160 CONTINUE
      IF(N1.LE.0)WRITE(ICOUT,999)
      IF(N1.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)WRITE(ICOUT,165)
  165 FORMAT('***** ERROR IN DPMEP2--N1 = 0')
      IF(N1.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)IERROR='YES'
      IF(N1.LE.0)GOTO9000
  169 CONTINUE
      AN1=N1
      IF(NUMFAC.LE.1)GOTO900
C
C               ***********************************************
C               **  STEP 1.2--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR FACTOR 2                             **
C               ***********************************************
C
CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
      ISTEPN='1.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      N2=0
      DO200I=1,N
      IF(N2.LE.0)GOTO250
      DO220J=1,N2
      IF(F2(I).EQ.F2ID(J))GOTO200
  220 CONTINUE
  250 N2=N2+1
      IF(N2.GT.MAXLEV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,290)MAXLEV
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
  290 FORMAT('***** ERROR IN DPMEP2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR 2')
      F2ID(N2)=F2(I)
  200 CONTINUE
      IF(N2.LE.0)WRITE(ICOUT,205)
  205 FORMAT('ERROR IN DPMEP2  SUBROUTINE--N2 = 0')
      IF(N2.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)IERROR='YES'
      IF(N2.LE.0)GOTO9000
  208 CONTINUE
      AN2=N2
      IF(NUMFAC.LE.2)GOTO900
C
C               ***********************************************
C               **  STEP 1.3--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR FACTOR 3                             **
C               ***********************************************
C
CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
      ISTEPN='1.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      N3=0
      DO300I=1,N
      IF(N3.LE.0)GOTO350
      DO320J=1,N3
      IF(F3(I).EQ.F3ID(J))GOTO300
  320 CONTINUE
  350 N3=N3+1
      IF(N3.GT.MAXLEV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,390)MAXLEV
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
  390 FORMAT('***** ERROR IN DPMEP2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR 3')
      F3ID(N3)=F3(I)
  300 CONTINUE
      IF(N3.LE.0)WRITE(ICOUT,305)
  305 FORMAT('ERROR IN DPMEP2  SUBROUTINE--N3 = 0')
      IF(N3.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)IERROR='YES'
      IF(N3.LE.0)GOTO9000
      AN3=N3
      IF(NUMFAC.LE.3)GOTO900
C
C               ***********************************************
C               **  STEP 1.4--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR FACTOR 4                             **
C               ***********************************************
C
CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
      ISTEPN='1.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      N4=0
      DO400I=1,N
      IF(N4.LE.0)GOTO450
      DO420J=1,N4
      IF(F4(I).EQ.F4ID(J))GOTO400
  420 CONTINUE
  450 N4=N4+1
      IF(N4.GT.MAXLEV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,490)MAXLEV
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
  490 FORMAT('***** ERROR IN DPMEP2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR 4')
      F4ID(N4)=F4(I)
  400 CONTINUE
      IF(N4.LE.0)WRITE(ICOUT,405)
  405 FORMAT('ERROR IN DPMEP2  SUBROUTINE--N4 = 0')
      IF(N4.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)IERROR='YES'
      IF(N4.LE.0)GOTO9000
      AN4=N4
      IF(NUMFAC.LE.4)GOTO900
C
C               ***********************************************
C               **  STEP 1.5--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR FACTOR 5                             **
C               ***********************************************
C
CCCCC JANUARY 1996.  CHECK FOR EXCEEDING MAXIMUM NUMBER OF LEVELS
      ISTEPN='1.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      N5=0
      DO500I=1,N
      IF(N5.LE.0)GOTO550
      DO520J=1,N5
      IF(F5(I).EQ.F5ID(J))GOTO500
  520 CONTINUE
  550 N5=N5+1
      IF(N5.GT.MAXLEV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG')
        WRITE(ICOUT,590)MAXLEV
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ENDIF
  590 FORMAT('***** ERROR IN DPMEP2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR 5')
      F5ID(N5)=F5(I)
  500 CONTINUE
      IF(N5.LE.0)WRITE(ICOUT,505)
  505 FORMAT('ERROR IN DPMEP2  SUBROUTINE--N5 = 0')
      IF(N5.LE.0)CALL DPWRST('XXX','BUG ')
      IF(N5.LE.0)IERROR='YES'
      IF(N5.LE.0)GOTO9000
      AN5=N5
      IF(NUMFAC.LE.5)GOTO900
C
  900 CONTINUE
C
C               **************************************
C               **  STEP 2--                        **
C               **  SORT THE LEVELS OF FACTOR 1     **
C               **  AND OF FACTOR 2                 **
C               **  AND OF FACTOR 3                 **
C               **  AND OF FACTOR 4                 **
C               **  AND OF FACTOR 5                 **
C               **  SO AS TO PUT THEM IN ORDER FOR  **
C               **  PRESENTATION PURPOSES.          **
C               **************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL SORT(F1ID,N1,F1ID)
      IF(NUMFAC.LE.1)GOTO1900
      CALL SORT(F2ID,N2,F2ID)
      IF(NUMFAC.LE.2)GOTO1900
      CALL SORT(F3ID,N3,F3ID)
      IF(NUMFAC.LE.3)GOTO1900
      CALL SORT(F4ID,N4,F4ID)
      IF(NUMFAC.LE.4)GOTO1900
      CALL SORT(F5ID,N5,F5ID)
      IF(NUMFAC.LE.5)GOTO1900
C
 1900 CONTINUE
C
C               ********************************************
C               **  STEP 3--                              **
C               **  DETERMINE IF HAVE                     **
C               **  REPLICATION WITHIN CELLS.             **
C               **  IF SO, COMPUTE (FOR EACH CELL)--      **
C               **         1) NUMBER OF OBSERVATIONS;     **
C               **         2) MEAN;                       **
C               **         3) SUM OF SQUARED DEVIATIONS.  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREP='NO'
      IREPDF=0
      REPDF=0.0
      REPSS=0.0
      REPSD=0.0
C
      IF(NUMFAC.EQ.1)GOTO3100
      IF(NUMFAC.EQ.2)GOTO3200
      IF(NUMFAC.EQ.3)GOTO3300
      IF(NUMFAC.EQ.4)GOTO3400
      IF(NUMFAC.EQ.5)GOTO3500
C
C               *******************************
C               **  STEP 3.1--               **
C               **  TREAT THE 1-FACTOR CASE  **
C               *******************************
C
 3100 CONTINUE
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      DO3110ISET1=1,N1
      K=K+1
      CELLN=0.0
      CELLME=0.0
CCCCC CELLSD(K)=0.0
C
      NI=0
      DO3160I=1,N
      IF(F1(I).NE.F1ID(ISET1))GOTO3160
      NI=NI+1
      Z(NI)=Y(I)
 3160 CONTINUE
C
      CELLN=NI
      IF(NI.LE.0)GOTO3190
      IF(NI.EQ.1)CELLME=Z(NI)
      IF(NI.EQ.1)GOTO3190
      IREP='YES'
      SUM=0.0
      DO3170I=1,NI
      SUM=SUM+Z(I)
 3170 CONTINUE
      CELLME=SUM/CELLN
C
      SUM=0.0
      DO3180I=1,NI
      SUM=SUM+(Z(I)-CELLME)**2
 3180 CONTINUE
      CELLV=SUM/(CELLN-1.0)
CCCCC IF(CELLV.LE.0.0)CELLSD(K)=0.0
CCCCC IF(CELLV.GT.0.0)CELLSD(K)=SQRT(CELLV)
C
      REPSS=REPSS+SUM
      IREPDF=IREPDF+NI-1
 3190 CONTINUE
 3110 CONTINUE
      GOTO3900
C
C               *******************************
C               **  STEP 3.2--               **
C               **  TREAT THE 2-FACTOR CASE  **
C               *******************************
C
 3200 CONTINUE
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      DO3210ISET1=1,N1
      DO3220ISET2=1,N2
      K=K+1
      CELLN=0.0
      CELLME=0.0
CCCCC CELLSD(K)=0.0
C
      NI=0
      DO3260I=1,N
      IF(F1(I).NE.F1ID(ISET1))GOTO3260
      IF(F2(I).NE.F2ID(ISET2))GOTO3260
      NI=NI+1
      Z(NI)=Y(I)
 3260 CONTINUE
C
      CELLN=NI
      IF(NI.LE.0)GOTO3290
      IF(NI.EQ.1)CELLME=Z(NI)
      IF(NI.EQ.1)GOTO3290
      IREP='YES'
      SUM=0.0
      DO3270I=1,NI
      SUM=SUM+Z(I)
 3270 CONTINUE
      CELLME=SUM/CELLN
C
      SUM=0.0
      DO3280I=1,NI
      SUM=SUM+(Z(I)-CELLME)**2
 3280 CONTINUE
      CELLV=SUM/(CELLN-1.0)
CCCCC IF(CELLV.LE.0.0)CELLSD(K)=0.0
CCCCC IF(CELLV.GT.0.0)CELLSD(K)=SQRT(CELLV)
C
      REPSS=REPSS+SUM
      IREPDF=IREPDF+NI-1
 3290 CONTINUE
 3220 CONTINUE
 3210 CONTINUE
      GOTO3900
C
C               *******************************
C               **  STEP 3.3--               **
C               **  TREAT THE 3-FACTOR CASE  **
C               *******************************
C
 3300 CONTINUE
      ISTEPN='3.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      DO3310ISET1=1,N1
      DO3320ISET2=1,N2
      DO3330ISET3=1,N3
      K=K+1
      CELLN=0.0
      CELLME=0.0
CCCCC CELLSD(K)=0.0
C
      NI=0
      DO3360I=1,N
      IF(F1(I).NE.F1ID(ISET1))GOTO3360
      IF(F2(I).NE.F2ID(ISET2))GOTO3360
      IF(F3(I).NE.F3ID(ISET3))GOTO3360
      NI=NI+1
      Z(NI)=Y(I)
 3360 CONTINUE
C
      CELLN=NI
      IF(NI.LE.0)GOTO3390
      IF(NI.EQ.1)CELLME=Z(NI)
      IF(NI.EQ.1)GOTO3390
      IREP='YES'
      SUM=0.0
      DO3370I=1,NI
      SUM=SUM+Z(I)
 3370 CONTINUE
      CELLME=SUM/CELLN
C
      SUM=0.0
      DO3380I=1,NI
      SUM=SUM+(Z(I)-CELLME)**2
 3380 CONTINUE
      CELLV=SUM/(CELLN-1.0)
CCCCC IF(CELLV.LE.0.0)CELLSD(K)=0.0
CCCCC IF(CELLV.GT.0.0)CELLSD(K)=SQRT(CELLV)
C
      IREPDF=IREPDF+NI-1
      REPSS=REPSS+SUM
 3390 CONTINUE
 3330 CONTINUE
 3320 CONTINUE
 3310 CONTINUE
      GOTO3900
C
C               *******************************
C               **  STEP 3.4--               **
C               **  TREAT THE 4-FACTOR CASE  **
C               *******************************
C
 3400 CONTINUE
      ISTEPN='3.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      DO3410ISET1=1,N1
      DO3420ISET2=1,N2
      DO3430ISET3=1,N3
      DO3440ISET4=1,N4
      K=K+1
      CELLN=0.0
      CELLME=0.0
CCCCC CELLSD(K)=0.0
C
      NI=0
      DO3460I=1,N
      IF(F1(I).NE.F1ID(ISET1))GOTO3460
      IF(F2(I).NE.F2ID(ISET2))GOTO3460
      IF(F3(I).NE.F3ID(ISET3))GOTO3460
      IF(F4(I).NE.F4ID(ISET4))GOTO3460
      NI=NI+1
      Z(NI)=Y(I)
 3460 CONTINUE
C
      CELLN=NI
      IF(NI.LE.0)GOTO3490
      IF(NI.EQ.1)CELLME=Z(NI)
      IF(NI.EQ.1)GOTO3490
      IREP='YES'
      SUM=0.0
      DO3470I=1,NI
      SUM=SUM+Z(I)
 3470 CONTINUE
      CELLME=SUM/CELLN
C
      SUM=0.0
      DO3480I=1,NI
      SUM=SUM+(Z(I)-CELLME)**2
 3480 CONTINUE
      CELLV=SUM/(CELLN-1.0)
CCCCC IF(CELLV.LE.0.0)CELLSD(K)=0.0
CCCCC IF(CELLV.GT.0.0)CELLSD(K)=SQRT(CELLV)
C
      REPSS=REPSS+SUM
      IREPDF=IREPDF+NI-1
 3490 CONTINUE
 3440 CONTINUE
 3430 CONTINUE
 3420 CONTINUE
 3410 CONTINUE
      GOTO3900
C
C               *******************************
C               **  STEP 3.5--               **
C               **  TREAT THE 5-FACTOR CASE  **
C               *******************************
C
 3500 CONTINUE
      ISTEPN='3.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      DO3510ISET1=1,N1
      DO3520ISET2=1,N2
      DO3530ISET3=1,N3
      DO3540ISET4=1,N4
      DO3550ISET5=1,N5
      K=K+1
      CELLN=0.0
      CELLME=0.0
CCCCC CELLSD(K)=0.0
C
      NI=0
      DO3560I=1,N
      IF(F1(I).NE.F1ID(ISET1))GOTO3560
      IF(F2(I).NE.F2ID(ISET2))GOTO3560
      IF(F3(I).NE.F3ID(ISET3))GOTO3560
      IF(F4(I).NE.F4ID(ISET4))GOTO3560
      IF(F5(I).NE.F5ID(ISET5))GOTO3560
      NI=NI+1
      Z(NI)=Y(I)
 3560 CONTINUE
C
      CELLN=NI
      IF(NI.LE.0)GOTO3590
      IF(NI.EQ.1)CELLME=Z(NI)
      IF(NI.EQ.1)GOTO3590
      IREP='YES'
      SUM=0.0
      DO3570I=1,NI
      SUM=SUM+Z(I)
 3570 CONTINUE
      CELLME=SUM/CELLN
C
      SUM=0.0
      DO3580I=1,NI
      SUM=SUM+(Z(I)-CELLME)**2
 3580 CONTINUE
      CELLV=SUM/(CELLN-1.0)
CCCCC IF(CELLV.LE.0.0)CELLSD(K)=0.0
CCCCC IF(CELLV.GT.0.0)CELLSD(K)=SQRT(CELLV)
C
      REPSS=REPSS+SUM
      IREPDF=IREPDF+NI-1
 3590 CONTINUE
 3550 CONTINUE
 3540 CONTINUE
 3530 CONTINUE
 3520 CONTINUE
 3510 CONTINUE
      GOTO3900
C
 3900 CONTINUE
      NUMCEL=K
      IF(IREP.EQ.'NO')GOTO3950
      REPDF=IREPDF
      REPMS=REPSS/REPDF
      IF(REPMS.LE.0.0)REPSD=0.0
      IF(REPMS.GT.0.0)REPSD=SQRT(REPMS)
 3950 CONTINUE
C
C               ******************************
C               **  STEP 4--                **
C               **  COMPUTE THE GRAND MEAN  **
C               ******************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO4100I=1,N
      SUM=SUM+Y(I)
 4100 CONTINUE
      GMEAN=SUM/AN
C
      CALL MEDIA2(Y,N,IWRITE,GMED,IBUGA3,IERROR)
C
      SUM=0.0
      DO4200I=1,N
      SUM=SUM+(Y(I)-GMEAN)**2
 4200 CONTINUE
      GSS=SUM
      GVAR=GSS/(AN-1.0)
      IF(GVAR.LE.0.0)GSD=0.0
      IF(GVAR.GT.0.0)GSD=SQRT(GVAR)
C
      YMIN=Y(1)
      YMAX=Y(1)
      DO4300I=1,N
      IF(Y(I).LT.YMIN)YMIN=Y(I)
      IF(Y(I).GT.YMAX)YMAX=Y(I)
 4300 CONTINUE
      GRANGE=YMAX-YMIN
C
C               **********************************************
C               **  STEP 5.01--                             **
C               **  INITIALIZE ROW AND COLUMN MEDIANS TO 0  **
C               **********************************************
C
      ISTEPN='5.01'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4500I=1,N
      RES2(I)=Y(I)
 4500 CONTINUE
C
      DO4510J=1,N1
      F1EFFE(J)=0.0
 4510 CONTINUE
      IF(NUMFAC.LE.1)GOTO4590
C
      DO4520J=1,N2
      F2EFFE(J)=0.0
 4520 CONTINUE
      IF(NUMFAC.LE.2)GOTO4590
C
      DO4530J=1,N3
      F3EFFE(J)=0.0
 4530 CONTINUE
      IF(NUMFAC.LE.3)GOTO4590
C
      DO4540J=1,N4
      F4EFFE(J)=0.0
 4540 CONTINUE
      IF(NUMFAC.LE.4)GOTO4590
C
      DO4550J=1,N5
      F5EFFE(J)=0.0
 4550 CONTINUE
      IF(NUMFAC.LE.5)GOTO4590
C
 4590 CONTINUE
C
C               ******************************************
C               **  STEP 5.02--                         **
C               **  COMPUTE THE NUMBER OF OBSERVATIONS  **
C               **  IN EACH LEVEL OF EACH VARIABLE      **
C               ******************************************
C
      ISTEPN='5.02'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4610J=1,N1
      K=0
      DO4612I=1,N
      IF(F1(I).EQ.F1ID(J))GOTO4614
      GOTO4612
 4614 CONTINUE
      K=K+1
 4612 CONTINUE
      F1N(J)=K
 4610 CONTINUE
      IF(NUMFAC.LE.1)GOTO4690
C
      DO4620J=1,N2
      K=0
      DO4622I=1,N
      IF(F2(I).EQ.F2ID(J))GOTO4624
      GOTO4622
 4624 CONTINUE
      K=K+1
 4622 CONTINUE
      F2N(J)=K
 4620 CONTINUE
      IF(NUMFAC.LE.2)GOTO4690
C
      DO4630J=1,N3
      K=0
      DO4632I=1,N
      IF(F3(I).EQ.F3ID(J))GOTO4634
      GOTO4632
 4634 CONTINUE
      K=K+1
 4632 CONTINUE
      F3N(J)=K
 4630 CONTINUE
      IF(NUMFAC.LE.3)GOTO4690
C
      DO4640J=1,N4
      K=0
      DO4642I=1,N
      IF(F4(I).EQ.F4ID(J))GOTO4644
      GOTO4642
 4644 CONTINUE
      K=K+1
 4642 CONTINUE
      F4N(J)=K
 4640 CONTINUE
      IF(NUMFAC.LE.4)GOTO4690
C
      DO4650J=1,N5
      K=0
      DO4652I=1,N
      IF(F5(I).EQ.F5ID(J))GOTO4654
      GOTO4652
 4654 CONTINUE
      K=K+1
 4652 CONTINUE
      F5N(J)=K
 4650 CONTINUE
      IF(NUMFAC.LE.5)GOTO4690
C
 4690 CONTINUE
C
C               *******************************************************
C               **  STEP 5.03--                                      **
C               **  DEFINE THE ITERATION LOOP FOR THE MEDIAN POLISH  **
C               *******************************************************
C
      ISTEPN='5.03'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5000IPASS=1,MAXPAS
C
      IF(IBUGA3.EQ.'OFF')GOTO5019
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)
 5011 FORMAT('******************************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5012)IPASS
 5012 FORMAT('AT BEGINNING OF PASS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5011)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 5019 CONTINUE
C
C               ***********************************************
C               **  STEP 5.1--                               **
C               **  FOR THIS PASS--                          **
C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 1)   **
C               **      1) UPDATED MEDIAN;                   **
C               **      2) UPDATED RESIDUALS                 **
C               ***********************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5100J=1,N1
C
      K=0
      DO5120I=1,N
      IF(F1(I).EQ.F1ID(J))GOTO5130
      GOTO5120
 5130 CONTINUE
      K=K+1
      Y2(K)=RES2(I)
 5120 CONTINUE
      CALL MEDIA2(Y2,K,IWRITE,Y2MED(J),IBUGA3,IERROR)
      F1EFFE(J)=F1EFFE(J)+Y2MED(J)
C
      DO5140I=1,N
      IF(F1(I).EQ.F1ID(J))GOTO5150
      GOTO5140
 5150 CONTINUE
      RES2(I)=RES2(I)-Y2MED(J)
 5140 CONTINUE
C
 5100 CONTINUE
C
      Y3MED=0.0
      IF(NUMFAC.GE.2.AND.IPASS.GE.2)
     1CALL MEDIA2(F2EFFE,N2,IWRITE,Y3MED,IBUGA3,IERROR)
      GTYP=GTYP+Y3MED
C
      DO5160J=1,N2
      F2EFFE(J)=F2EFFE(J)-Y3MED
 5160 CONTINUE
C
      DO5170J=1,N1
      F1TYP(J)=GTYP+F1EFFE(J)
 5170 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO5189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('***** AFTER THE HORIZONTAL SWEEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5182I=1,N
      WRITE(ICOUT,5183)I,RES2(I)
 5183 FORMAT('I,RES2(I)  = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5182 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5184J=1,N1
      WRITE(ICOUT,5185)J,F1EFFE(J)
 5185 FORMAT('J,F1EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5184 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5186J=1,N2
      WRITE(ICOUT,5187)J,F2EFFE(J)
 5187 FORMAT('J,F2EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5186 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5188)GTYP
 5188 FORMAT('GTYP       = ',8X,E15.7)
      CALL DPWRST('XXX','BUG ')
 5189 CONTINUE
C
      IF(NUMFAC.LE.1)GOTO5800
C
C               ***********************************************
C               **  STEP 5.2--                               **
C               **  FOR THIS PASS--                          **
C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 2)   **
C               **      1) UPDATED MEDIAN;                   **
C               **      2) UPDATED RESIDUALS                 **
C               ***********************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5200J=1,N2
C
      K=0
      DO5220I=1,N
      IF(F2(I).EQ.F2ID(J))GOTO5230
      GOTO5220
 5230 CONTINUE
      K=K+1
      Y2(K)=RES2(I)
 5220 CONTINUE
      CALL MEDIA2(Y2,K,IWRITE,Y2MED(J),IBUGA3,IERROR)
      F2EFFE(J)=F2EFFE(J)+Y2MED(J)
C
      DO5240I=1,N
      IF(F2(I).EQ.F2ID(J))GOTO5250
      GOTO5240
 5250 CONTINUE
      RES2(I)=RES2(I)-Y2MED(J)
 5240 CONTINUE
C
 5200 CONTINUE
C
      CALL MEDIA2(F1EFFE,N1,IWRITE,Y3MED,IBUGA3,IERROR)
      GTYP=GTYP+Y3MED
C
      DO5260J=1,N1
      F1EFFE(J)=F1EFFE(J)-Y3MED
 5260 CONTINUE
C
      DO5270J=1,N2
      F2TYP(J)=GTYP+F2EFFE(J)
 5270 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO5289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5281)
 5281 FORMAT('***** AFTER THE VERTICAL   SWEEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5282I=1,N
      WRITE(ICOUT,5283)I,RES2(I)
 5283 FORMAT('I,RES2(I)  = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5282 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5284J=1,N1
      WRITE(ICOUT,5285)J,F1EFFE(J)
 5285 FORMAT('J,F1EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5284 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5286J=1,N2
      WRITE(ICOUT,5287)J,F2EFFE(J)
 5287 FORMAT('J,F2EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5286 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5288)GTYP
 5288 FORMAT('GTYP       = ',8X,E15.7)
      CALL DPWRST('XXX','BUG ')
 5289 CONTINUE
      IF(NUMFAC.LE.2)GOTO5800
C
C               ***********************************************
C               **  STEP 5.3--                               **
C               **  FOR THIS PASS--                          **
C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 3)   **
C               **      1) UPDATED MEDIAN;                   **
C               **      2) UPDATED RESIDUALS                 **
C               ***********************************************
C
      ISTEPN='5.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5300J=1,N3
C
      K=0
      DO5320I=1,N
      IF(F3(I).EQ.F3ID(J))GOTO5330
      GOTO5320
 5330 CONTINUE
      K=K+1
      Y2(K)=RES2(I)
 5320 CONTINUE
      CALL MEDIA2(Y2,K,IWRITE,Y2MED(J),IBUGA3,IERROR)
      F3EFFE(J)=F3EFFE(J)+Y2MED(J)
C
      DO5340I=1,N
      IF(F3(I).EQ.F3ID(J))GOTO5350
      GOTO5340
 5350 CONTINUE
      RES2(I)=RES2(I)-Y2MED(J)
 5340 CONTINUE
C
 5300 CONTINUE
C
      CALL MEDIA2(F1EFFE,N1,IWRITE,Y3MED,IBUGA3,IERROR)
      GTYP=GTYP+Y3MED
C
      DO5360J=1,N1
      F1EFFE(J)=F1EFFE(J)-Y3MED
 5360 CONTINUE
C
      DO5370J=1,N3
      F3TYP(J)=GTYP+F3EFFE(J)
 5370 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO5389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5381)
 5381 FORMAT('***** AFTER THE DIMENSION 3 SWEEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5382I=1,N
      WRITE(ICOUT,5383)I,RES2(I)
 5383 FORMAT('I,RES2(I)  = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5382 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5384J=1,N1
      WRITE(ICOUT,5385)J,F1EFFE(J)
 5385 FORMAT('J,F1EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5384 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5386J=1,N2
      WRITE(ICOUT,5387)J,F2EFFE(J)
 5387 FORMAT('J,F2EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5386 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5388)GTYP
 5388 FORMAT('GTYP       = ',8X,E15.7)
      CALL DPWRST('XXX','BUG ')
 5389 CONTINUE
      IF(NUMFAC.LE.3)GOTO5800
C
C               ***********************************************
C               **  STEP 5.4--                               **
C               **  FOR THIS PASS--                          **
C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 4)   **
C               **      1) UPDATED MEDIAN;                   **
C               **      2) UPDATED RESIDUALS                 **
C               ***********************************************
C
      ISTEPN='5.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5400J=1,N4
C
      K=0
      DO5420I=1,N
      IF(F4(I).EQ.F4ID(J))GOTO5430
      GOTO5420
 5430 CONTINUE
      K=K+1
      Y2(K)=RES2(I)
 5420 CONTINUE
      CALL MEDIA2(Y2,K,IWRITE,Y2MED(J),IBUGA3,IERROR)
      F4EFFE(J)=F4EFFE(J)+Y2MED(J)
C
      DO5440I=1,N
      IF(F4(I).EQ.F4ID(J))GOTO5450
      GOTO5440
 5450 CONTINUE
      RES2(I)=RES2(I)-Y2MED(J)
 5440 CONTINUE
C
 5400 CONTINUE
C
      CALL MEDIA2(F1EFFE,N1,IWRITE,Y3MED,IBUGA3,IERROR)
      GTYP=GTYP+Y3MED
C
      DO5460J=1,N1
      F1EFFE(J)=F1EFFE(J)-Y3MED
 5460 CONTINUE
C
      DO5470J=1,N4
      F4TYP(J)=GTYP+F4EFFE(J)
 5470 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO5489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5481)
 5481 FORMAT('***** AFTER THE DIMENSION 4 SWEEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5482I=1,N
      WRITE(ICOUT,5483)I,RES2(I)
 5483 FORMAT('I,RES2(I)  = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5482 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5484J=1,N1
      WRITE(ICOUT,5485)J,F1EFFE(J)
 5485 FORMAT('J,F1EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5484 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5486J=1,N2
      WRITE(ICOUT,5487)J,F2EFFE(J)
 5487 FORMAT('J,F2EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5486 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5488)GTYP
 5488 FORMAT('GTYP       = ',8X,E15.7)
      CALL DPWRST('XXX','BUG ')
 5489 CONTINUE
      IF(NUMFAC.LE.4)GOTO5800
C
C               ***********************************************
C               **  STEP 5.5--                               **
C               **  FOR THIS PASS--                          **
C               **  DETERMINE (FOR EACH LEVEL OF FACTOR 5)   **
C               **      1) UPDATED MEDIAN;                   **
C               **      2) UPDATED RESIDUALS                 **
C               ***********************************************
C
      ISTEPN='5.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5500J=1,N5
C
      K=0
      DO5520I=1,N
      IF(F5(I).EQ.F5ID(J))GOTO5530
      GOTO5520
 5530 CONTINUE
      K=K+1
      Y2(K)=RES2(I)
 5520 CONTINUE
      CALL MEDIA2(Y2,K,IWRITE,Y2MED(J),IBUGA3,IERROR)
      F5EFFE(J)=F5EFFE(J)+Y2MED(J)
C
      DO5540I=1,N
      IF(F5(I).EQ.F5ID(J))GOTO5550
      GOTO5540
 5550 CONTINUE
      RES2(I)=RES2(I)-Y2MED(J)
 5540 CONTINUE
C
 5500 CONTINUE
C
      CALL MEDIA2(F1EFFE,N1,IWRITE,Y3MED,IBUGA3,IERROR)
      GTYP=GTYP+Y3MED
C
      DO5560J=1,N1
      F1EFFE(J)=F1EFFE(J)-Y3MED
 5560 CONTINUE
C
      DO5570J=1,N5
      F5TYP(J)=GTYP+F5EFFE(J)
 5570 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO5589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5581)
 5581 FORMAT('***** AFTER THE DIMENSION 5 SWEEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5582I=1,N
      WRITE(ICOUT,5583)I,RES2(I)
 5583 FORMAT('I,RES2(I)  = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5582 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5584J=1,N1
      WRITE(ICOUT,5585)J,F1EFFE(J)
 5585 FORMAT('J,F1EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5584 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO5586J=1,N2
      WRITE(ICOUT,5587)J,F2EFFE(J)
 5587 FORMAT('J,F2EFFE(J) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5586 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5588)GTYP
 5588 FORMAT('GTYP       = ',8X,E15.7)
      CALL DPWRST('XXX','BUG ')
 5589 CONTINUE
      IF(NUMFAC.LE.5)GOTO5800
C
C               *************************************************************
C               **  STEP 5.6--                                             **
C               **  DETERMINE IF THE CHANGE IN THE  RESIDUALS              **
C               **  (FROM THIS PASS AS COMPARED TO THE PREVIOUS PASS)      **
C               **  IS SO SMALL THAT THE ITERATIONS SHOULD BE TERMINATED.  **
C               *************************************************************
C
 5800 CONTINUE
C
      ISTEPN='5.6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO5810I=1,N
      SUM=SUM+ABS(RES2(I))
 5810 CONTINUE
      AARES=SUM/AN
C
      IF(IBUGA3.EQ.'OFF')GOTO5819
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5811)IPASS
 5811 FORMAT('***** AT THE CLOSE OF PASS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5812)IPASS,AN,SUM,AARES,AARESO
 5812 FORMAT('IPASS,AN,SUM,AARES,AARESO = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 5819 CONTINUE
C
      IF(AARES.LE.0.0)GOTO5900
C
      IF(IPASS.EQ.1)AARESO=AARES
      IF(IPASS.EQ.1)GOTO5000
C
      RATIO=AARES/AARESO
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,5816)IPASS,AARES,AARESO,RATIO,CUTOFF
 5816 FORMAT('IPASS,AARES,AARESO,RATIO,CUTOFF = ',I8,4E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(RATIO.GE.CUTOFF)GOTO5900
      AARESO=AARES
      GOTO5000
C
 5000 CONTINUE
C
 5900 CONTINUE
C
C               ******************************************
C               **  STEP 6--                            **
C               **  COMPUTE THE FOLLOWING--             **
C               **     1) PREDICTED VALUES;             **
C               **     2) RESIDUALS;                    **
C               **     3) RESIDUAL STANDARD DEVIATION;  **
C               **     4) RESIDUAL DEGREES OF FREEDOM;  **
C               **  IF HAVE REPLICATION,                **
C               **  THEN ALSO CARRY OUT                 **
C               **  THE LACK OF FIT F TEST.             **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      RESSS=0.0
      IRESDF=0
      RESDF=0.0
      RESMS=0.0
      RESSD=0.0
      ALFCDF=(-999.99)
C
      DO6000I=1,N
C
      DO6100ISET1=1,N1
      J1=ISET1
      IF(F1(I).EQ.F1ID(ISET1))GOTO6115
 6100 CONTINUE
 6115 CONTINUE
      E1=F1EFFE(J1)
      IF(NUMFAC.LE.1)GOTO6900
C
      DO6200ISET2=1,N2
      J2=ISET2
      IF(F2(I).EQ.F2ID(ISET2))GOTO6215
 6200 CONTINUE
 6215 CONTINUE
      E2=F2EFFE(J2)
      IF(NUMFAC.LE.2)GOTO6900
C
      DO6300ISET3=1,N3
      J3=ISET3
      IF(F3(I).EQ.F3ID(ISET3))GOTO6315
 6300 CONTINUE
 6315 CONTINUE
      E3=F3EFFE(J3)
      IF(NUMFAC.LE.3)GOTO6900
C
      DO6400ISET4=1,N4
      J4=ISET4
      IF(F4(I).EQ.F4ID(ISET4))GOTO6415
 6400 CONTINUE
 6415 CONTINUE
      E4=F4EFFE(J4)
      IF(NUMFAC.LE.4)GOTO6900
C
      DO6500ISET5=1,N5
      J5=ISET5
      IF(F5(I).EQ.F5ID(ISET5))GOTO6515
 6500 CONTINUE
 6515 CONTINUE
      E5=F5EFFE(J5)
      IF(NUMFAC.LE.5)GOTO6900
C
 6900 CONTINUE
      IF(NUMFAC.EQ.1)PRED2(I)=GTYP+E1
      IF(NUMFAC.EQ.2)PRED2(I)=GTYP+E1+E2
      IF(NUMFAC.EQ.3)PRED2(I)=GTYP+E1+E2+E3
      IF(NUMFAC.EQ.4)PRED2(I)=GTYP+E1+E2+E3+E4
      IF(NUMFAC.EQ.5)PRED2(I)=GTYP+E1+E2+E3+E4+E5
 6000 CONTINUE
CCCCC RES2(I)=Y(I)-PRED2(I)
C
      IF(NUMFAC.EQ.1)IRESDF=N-(1+(N1-1))
      IF(NUMFAC.EQ.2)IRESDF=N-(1+(N1-1)+(N2-1))
      IF(NUMFAC.EQ.3)IRESDF=N-(1+(N1-1)+(N2-1)+(N3-1))
      IF(NUMFAC.EQ.4)IRESDF=N-(1+(N1-1)+(N2-1)+(N3-1)+(N4-1))
      IF(NUMFAC.EQ.5)IRESDF=N-(1+(N1-1)+(N2-1)+(N3-1)+(N4-1)+(N5-1))
      RESDF=IRESDF
C
      SUM=0.0
      DO6910I=1,N
      SUM=SUM+RES2(I)*RES2(I)
 6910 CONTINUE
      RESSS=SUM
      RESMS=RESSS/RESDF
      IF(RESMS.LE.0.0)RESSD=0.0
      IF(RESMS.GT.0.0)RESSD=SQRT(RESMS)
C
      IF(IREP.EQ.'NO')GOTO6990
      IFITDF=IRESDF-IREPDF
      FITDF=IFITDF
      IF(IFITDF.LE.0)GOTO6990
      FITSS=RESSS-REPSS
      FITMS=FITSS/FITDF
      FITFVA=FITMS/REPMS
      CALL FCDF(FITFVA,IFITDF,IREPDF,FITCDF)
      FITCD2=100.0*FITCDF
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988.
      ALFCDF=FITCDF
 6990 CONTINUE
C
C               ************************************************
C               **  STEP 7--                                  **
C               **  COMPUTE THE ESTIMATED STANDARD DEVIATION  **
C               **  OF THE GRAND MEAN                         **
C               **  AND THE ESTIMATED STANDARD DEVIATION      **
C               **  OF THE ESTIMATED EFFECTS.                 **
C               ************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.0)GMEASD=0.0
      IF(N.GT.0)GMEASD=RESSD/SQRT(AN)
C
      DO7100ISET1=1,N1
      ANI=F1N(ISET1)
      CONST=((1.0/ANI)-(1.0/AN))
      IF(CONST.LE.0.0)F1EFSD(ISET1)=0.0
      IF(CONST.GT.0.0)F1EFSD(ISET1)=RESSD*SQRT(CONST)
 7100 CONTINUE
      IF(NUMFAC.LE.1)GOTO7900
C
      DO7200ISET2=1,N2
      ANI=F2N(ISET2)
      CONST=((1.0/ANI)-(1.0/AN))
      IF(CONST.LE.0.0)F2EFSD(ISET2)=0.0
      IF(CONST.GT.0.0)F2EFSD(ISET2)=RESSD*SQRT(CONST)
 7200 CONTINUE
      IF(NUMFAC.LE.2)GOTO7900
C
      DO7300ISET3=1,N3
      ANI=F3N(ISET3)
      CONST=((1.0/ANI)-(1.0/AN))
      IF(CONST.LE.0.0)F3EFSD(ISET3)=0.0
      IF(CONST.GT.0.0)F3EFSD(ISET3)=RESSD*SQRT(CONST)
 7300 CONTINUE
      IF(NUMFAC.LE.3)GOTO7900
C
      DO7400ISET4=1,N4
      ANI=F4N(ISET4)
      CONST=((1.0/ANI)-(1.0/AN))
      IF(CONST.LE.0.0)F4EFSD(ISET4)=0.0
      IF(CONST.GT.0.0)F4EFSD(ISET4)=RESSD*SQRT(CONST)
 7400 CONTINUE
      IF(NUMFAC.LE.4)GOTO7900
C
      DO7500ISET5=1,N5
      ANI=F5N(ISET5)
      CONST=((1.0/ANI)-(1.0/AN))
      IF(CONST.LE.0.0)F5EFSD(ISET5)=0.0
      IF(CONST.GT.0.0)F5EFSD(ISET5)=RESSD*SQRT(CONST)
 7500 CONTINUE
      IF(NUMFAC.LE.5)GOTO7900
C
 7900 CONTINUE
C
C               ********************************
C               **  STEP 8--                  **
C               **  PERFORM THE F TEST        **
C               **  TO TEST THE SIGNIFICANCE  **
C               **  OF FACTOR 1               **
C               **  OF FACTOR 2               **
C               **  OF FACTOR 3               **
C               **  OF FACTOR 4               **
C               **  OF FACTOR 5               **
C               ********************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO8100J=1,N1
      SUM=SUM+F1N(J)*F1EFFE(J)*F1EFFE(J)
 8100 CONTINUE
      SS1=SUM
      IDF1=N1-1
      DF1=IDF1
      RESMS1=SS1/DF1
      IF(RESMS1.LE.0.0)RSD(1)=0.0
      IF(RESMS1.GT.0.0)RSD(1)=SQRT(RESMS1)
      FVAL(1)=RESMS1/RESMS
      CALL FCDF(FVAL(1),IDF1,IRESDF,FCUM(1))
      F1CDF2=100.0*FCUM(1)
      IF(NUMFAC.LE.1)GOTO8900
C
      SUM=0.0
      DO8200J=1,N2
      SUM=SUM+F2N(J)*F2EFFE(J)*F2EFFE(J)
 8200 CONTINUE
      SS=SUM
      IDF=N2-1
      DF=IDF
      RESMS2=SS/DF
      IF(RESMS2.LE.0.0)RSD(2)=0.0
      IF(RESMS2.GT.0.0)RSD(2)=SQRT(RESMS2)
      FVAL(2)=RESMS2/RESMS
      CALL FCDF(FVAL(2),IDF,IRESDF,FCUM(2))
      F2CDF2=100.0*FCUM(2)
      IF(NUMFAC.LE.2)GOTO8900
C
      SUM=0.0
      DO8300J=1,N3
      SUM=SUM+F3N(J)*F3EFFE(J)*F3EFFE(J)
 8300 CONTINUE
      SS=SUM
      IDF=N3-1
      DF=IDF
      RESMS3=SS/DF
      IF(RESMS3.LE.0.0)RSD(3)=0.0
      IF(RESMS3.GT.0.0)RSD(3)=SQRT(RESMS3)
      FVAL(3)=RESMS3/RESMS
      CALL FCDF(FVAL(3),IDF,IRESDF,FCUM(3))
      F3CDF2=100.0*FCUM(3)
      IF(NUMFAC.LE.3)GOTO8900
C
      SUM=0.0
      DO8400J=1,N4
      SUM=SUM+F4N(J)*F4EFFE(J)*F4EFFE(J)
 8400 CONTINUE
      SS=SUM
      IDF=N4-1
      DF=IDF
      RESMS4=SS/DF
      IF(RESMS4.LE.0.0)RSD(4)=0.0
      IF(RESMS4.GT.0.0)RSD(4)=SQRT(RESMS4)
      FVAL(4)=RESMS4/RESMS
      CALL FCDF(FVAL(4),IDF,IRESDF,FCUM(4))
      F4CDF2=100.0*FCUM(4)
      IF(NUMFAC.LE.4)GOTO8900
C
      SUM=0.0
      DO8500J=1,N5
      SUM=SUM+F5N(J)*F5EFFE(J)*F5EFFE(J)
 8500 CONTINUE
      SS=SUM
      IDF=N5-1
      DF=IDF
      RESMS5=SS/DF
      IF(RESMS5.LE.0.0)RSD(5)=0.0
      IF(RESMS5.GT.0.0)RSD(5)=SQRT(RESMS5)
      FVAL(5)=RESMS5/RESMS
      CALL FCDF(FVAL(5),IDF,IRESDF,FCUM(5))
      F5CDF2=100.0*FCUM(5)
      IF(NUMFAC.LE.5)GOTO8900
C
 8900 CONTINUE
C
C               *************************************************
C               **  STEP 9.1--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR THE 1-FACTOR MODEL                     **
C               **  FOR FACTOR 1 ONLY.                         **
C               *************************************************
C
      ISTEPN='9.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO9100I=1,N
      DO9110J=1,N1
      J1=J
      IF(F1(I).EQ.F1ID(J))GOTO9120
 9110 CONTINUE
 9120 CONTINUE
      WMEAN=F1TYP(J1)
      SUM=SUM+(Y(I)-WMEAN)**2
 9100 CONTINUE
      WSS1=SUM
      WDF1=AN-AN1
      WVAR1=WSS1/WDF1
      IF(WVAR1.LE.0.0)WSD1=0.0
      IF(WVAR1.GT.0.0)WSD1=SQRT(WVAR1)
      RSD(1)=WSD1
      IF(NUMFAC.LE.1)GOTO9900
C
C               *************************************************
C               **  STEP 9.2--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR THE 1-FACTOR MODEL                     **
C               **  FOR FACTOR 2 ONLY.                         **
C               *************************************************
C
      ISTEPN='9.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO9200I=1,N
      DO9210J=1,N2
      J1=J
      IF(F2(I).EQ.F2ID(J))GOTO9220
 9210 CONTINUE
 9220 CONTINUE
      WMEAN=F2TYP(J1)
      SUM=SUM+(Y(I)-WMEAN)**2
 9200 CONTINUE
      WSS2=SUM
      WDF2=AN-AN2
      WVAR2=WSS2/WDF2
      IF(WVAR2.LE.0.0)WSD2=0.0
      IF(WVAR2.GT.0.0)WSD2=SQRT(WVAR2)
      RSD(2)=WSD2
      IF(NUMFAC.LE.2)GOTO9900
C
C               *************************************************
C               **  STEP 9.3--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR THE 1-FACTOR MODEL                     **
C               **  FOR FACTOR 3 ONLY.                         **
C               *************************************************
C
      ISTEPN='9.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO9300I=1,N
      DO9310J=1,N3
      J1=J
      IF(F3(I).EQ.F3ID(J))GOTO9320
 9310 CONTINUE
 9320 CONTINUE
      WMEAN=F3TYP(J1)
      SUM=SUM+(Y(I)-WMEAN)**2
 9300 CONTINUE
      WSS3=SUM
      WDF3=AN-AN3
      WVAR3=WSS3/WDF3
      IF(WVAR3.LE.0.0)WSD3=0.0
      IF(WVAR3.GT.0.0)WSD3=SQRT(WVAR3)
      RSD(3)=WSD3
      IF(NUMFAC.LE.3)GOTO9900
C
C               *************************************************
C               **  STEP 9.4--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR THE 1-FACTOR MODEL                     **
C               **  FOR FACTOR 4 ONLY.                         **
C               *************************************************
C
      ISTEPN='9.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO9400I=1,N
      DO9410J=1,N4
      J1=J
      IF(F4(I).EQ.F4ID(J))GOTO9420
 9410 CONTINUE
 9420 CONTINUE
      WMEAN=F4TYP(J1)
      SUM=SUM+(Y(I)-WMEAN)**2
 9400 CONTINUE
      WSS4=SUM
      WDF4=AN-AN4
      WVAR4=WSS4/WDF4
      IF(WVAR4.LE.0.0)WSD4=0.0
      IF(WVAR4.GT.0.0)WSD4=SQRT(WVAR4)
      RSD(4)=WSD4
      IF(NUMFAC.LE.4)GOTO9900
C
C               *************************************************
C               **  STEP 9.5--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR THE 1-FACTOR MODEL                     **
C               **  FOR FACTOR 5 ONLY.                         **
C               *************************************************
C
      ISTEPN='9.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO9500I=1,N
      DO9510J=1,N5
      J1=J
      IF(F5(I).EQ.F5ID(J))GOTO9520
 9510 CONTINUE
 9520 CONTINUE
      WMEAN=F5TYP(J1)
      SUM=SUM+(Y(I)-WMEAN)**2
 9500 CONTINUE
      WSS5=SUM
      WDF5=AN-AN5
      WVAR5=WSS5/WDF5
      IF(WVAR5.LE.0.0)WSD5=0.0
      IF(WVAR5.GT.0.0)WSD5=SQRT(WVAR5)
      RSD(5)=WSD5
      IF(NUMFAC.LE.5)GOTO9900
C
 9900 CONTINUE
C
C
C               ****************************************************************
C               **  STEP 10--
C               **  COPY OVER INTO THE OUTPUT VECTORS B(.) AND SDB(.)--
C               **       1) THE GRAND MEAN;
C               **       2) THE ESTIMATED EFFECTS;
C               **       3) THE STANDARD DEVIATIONS OF GRAND MEAN AND EFFECTS.
C               ****************************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=1
      B(K)=GTYP
      SDB(K)=GMEASD
C
      DO10100ISET1=1,N1
      K=K+1
      B(K)=F1EFFE(ISET1)
      SDB(K)=F1EFSD(ISET1)
10100 CONTINUE
      IF(NUMFAC.LE.1)GOTO10900
C
      DO10200ISET2=1,N2
      K=K+1
      B(K)=F2EFFE(ISET2)
      SDB(K)=F2EFSD(ISET2)
10200 CONTINUE
      IF(NUMFAC.LE.2)GOTO10900
C
      DO10300ISET3=1,N3
      K=K+1
      B(K)=F3EFFE(ISET3)
      SDB(K)=F3EFSD(ISET3)
10300 CONTINUE
      IF(NUMFAC.LE.3)GOTO10900
C
      DO10400ISET4=1,N4
      K=K+1
      B(K)=F4EFFE(ISET4)
      SDB(K)=F4EFSD(ISET4)
10400 CONTINUE
      IF(NUMFAC.LE.4)GOTO10900
C
      DO10500ISET5=1,N5
      K=K+1
      B(K)=F5EFFE(ISET5)
      SDB(K)=F5EFSD(ISET5)
10500 CONTINUE
      IF(NUMFAC.LE.5)GOTO10900
C
10900 CONTINUE
C
C               ****************************
C               **  STEP 11--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO11690
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11101)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11101)
11101 FORMAT('                ***************************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11102)NUMFAC
11102 FORMAT('                ** ',I2,'-WAY MEDIAN POLISH',
     1'  **')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11101)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11101)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11103)N
11103 FORMAT('      NUMBER OF OBSERVATIONS           = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11104)NUMFAC
11104 FORMAT('      NUMBER OF FACTORS                = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.1)WRITE(ICOUT,11111)N1
11111 FORMAT('      NUMBER OF LEVELS FOR FACTOR 1    = ',I8)
      IF(NUMFAC.GE.1)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.2)WRITE(ICOUT,11112)N2
11112 FORMAT('      NUMBER OF LEVELS FOR FACTOR 2    = ',I8)
      IF(NUMFAC.GE.2)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.3)WRITE(ICOUT,11113)N3
11113 FORMAT('      NUMBER OF LEVELS FOR FACTOR 3    = ',I8)
      IF(NUMFAC.GE.3)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.4)WRITE(ICOUT,11114)N4
11114 FORMAT('      NUMBER OF LEVELS FOR FACTOR 4    = ',I8)
      IF(NUMFAC.GE.4)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.5)WRITE(ICOUT,11115)N5
11115 FORMAT('      NUMBER OF LEVELS FOR FACTOR 5    = ',I8)
      IF(NUMFAC.GE.5)CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,11123)RESSD
11123 FORMAT('      RESIDUAL    STANDARD DEVIATION   = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11124)IRESDF
11124 FORMAT('      RESIDUAL    DEGREES OF FREEDOM   = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'NO')WRITE(ICOUT,11201)
11201 FORMAT('      NO REPLICATION CASE')
      IF(IREP.EQ.'NO')CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,11202)
11202 FORMAT('      REPLICATION CASE')
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,11203)REPSD
11203 FORMAT('      REPLICATION STANDARD DEVIATION   = ',E20.11)
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,11204)IREPDF
11204 FORMAT('      REPLICATION DEGREES OF FREEDOM   = ',I8)
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11205)NUMCEL
11205 FORMAT('      NUMBER OF DISTINCT CELLS         = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,11301)
11301 FORMAT('                         ****************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11302)
11302 FORMAT('                         *  ESTIMATION  *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11301)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11211)GMEAN
11211 FORMAT('      GRAND MEAN                       = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11212)GMED
11212 FORMAT('      GRAND MEDIAN                     = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11213)GTYP
11213 FORMAT('      MEDIAN POLISH TYPICAL VALUE      = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11214)GRANGE
11214 FORMAT('      GRAND RANGE                      = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11215)GSD
11215 FORMAT('      GRAND STANDARD DEVIATION         = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11304)
11304 FORMAT('             LEVEL-ID      NI   TYP. VALUE   ',
     1'EFFECT     ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11305)
11305 FORMAT('-----------------------------------------------',
     1'---------------------')
      CALL DPWRST('XXX','BUG ')
      DO11510I=1,N1
      IF(I.EQ.1)
     1WRITE(ICOUT,11511)F1ID(I),F1N(I),F1TYP(I),F1EFFE(I)
11511 FORMAT('FACTOR  1--',F11.5,F8.0,2F11.5)
      IF(I.EQ.1)
     1CALL DPWRST('XXX','BUG ')
      IF(I.NE.1)
     1WRITE(ICOUT,11512)F1ID(I),F1N(I),F1TYP(I),F1EFFE(I)
11512 FORMAT('         --',F11.5,F8.0,2F11.5)
      IF(I.NE.1)
     1CALL DPWRST('XXX','BUG ')
11510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.1)GOTO11590
C
      DO11520I=1,N2
      IF(I.EQ.1)
     1WRITE(ICOUT,11521)F2ID(I),F2N(I),F2TYP(I),F2EFFE(I)
11521 FORMAT('FACTOR  2--',F11.5,F8.0,3F11.5)
      IF(I.EQ.1)
     1CALL DPWRST('XXX','BUG ')
      IF(I.NE.1)
     1WRITE(ICOUT,11522)F2ID(I),F2N(I),F2TYP(I),F2EFFE(I)
11522 FORMAT('         --',F11.5,F8.0,3F11.5)
      IF(I.NE.1)
     1CALL DPWRST('XXX','BUG ')
11520 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.2)GOTO11590
C
      DO11530I=1,N3
      IF(I.EQ.1)
     1WRITE(ICOUT,11531)F3ID(I),F3N(I),F3TYP(I),F3EFFE(I)
11531 FORMAT('FACTOR  3--',F11.5,F8.0,3F11.5)
      IF(I.EQ.1)
     1CALL DPWRST('XXX','BUG ')
      IF(I.NE.1)
     1WRITE(ICOUT,11532)F3ID(I),F3N(I),F3TYP(I),F3EFFE(I)
11532 FORMAT('         --',F11.5,F8.0,3F11.5)
      IF(I.NE.1)
     1CALL DPWRST('XXX','BUG ')
11530 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.3)GOTO11590
C
      DO11540I=1,N4
      IF(I.EQ.1)
     1WRITE(ICOUT,11541)F4ID(I),F4N(I),F4TYP(I),F4EFFE(I)
11541 FORMAT('FACTOR  4--',F11.5,F8.0,3F11.5)
      IF(I.EQ.1)
     1CALL DPWRST('XXX','BUG ')
      IF(I.NE.1)
     1WRITE(ICOUT,11542)F4ID(I),F4N(I),F4TYP(I),F4EFFE(I)
11542 FORMAT('         --',F11.5,F8.0,3F11.5)
      IF(I.NE.1)
     1CALL DPWRST('XXX','BUG ')
11540 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.4)GOTO11590
C
      DO11550I=1,N5
      IF(I.EQ.1)
     1WRITE(ICOUT,11551)F5ID(I),F5N(I),F5TYP(I),F5EFFE(I)
11551 FORMAT('FACTOR  5--',F11.5,F8.0,3F11.5)
      IF(I.EQ.1)
     1CALL DPWRST('XXX','BUG ')
      IF(I.NE.1)
     1WRITE(ICOUT,11552)F5ID(I),F5N(I),F5TYP(I),F5EFFE(I)
11552 FORMAT('         --',F11.5,F8.0,3F11.5)
      IF(I.NE.1)
     1CALL DPWRST('XXX','BUG ')
11550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.5)GOTO11590
C
11590 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12815)
12815 FORMAT('        MODEL               RESIDUAL STANDARD ',
     1'DEVIATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12816)
12816 FORMAT('----------------------------------------------',
     1'---------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,12820)GSD
12820 FORMAT('CONSTANT             ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.0)GOTO12890
      WRITE(ICOUT,12821)RSD(1)
12821 FORMAT('CONSTANT & FACTOR  1 ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.1)GOTO12890
      WRITE(ICOUT,12822)RSD(2)
12822 FORMAT('CONSTANT & FACTOR  2 ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.EQ.2)WRITE(ICOUT,12832)RESSD
12832 FORMAT('CONSTANT & BOTH FACTORS  --',F20.10)
      IF(NUMFAC.EQ.2)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.2)GOTO12890
      WRITE(ICOUT,12823)RSD(3)
12823 FORMAT('CONSTANT & FACTOR  3 ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.EQ.3)WRITE(ICOUT,12833)RESSD
12833 FORMAT('CONSTANT & ALL 3 FACTORS --',F20.10)
      IF(NUMFAC.EQ.3)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.3)GOTO12890
      WRITE(ICOUT,12824)RSD(4)
12824 FORMAT('CONSTANT & FACTOR  4 ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.EQ.4)WRITE(ICOUT,12834)RESSD
12834 FORMAT('CONSTANT & ALL 4 FACTORS --',F20.10)
      IF(NUMFAC.EQ.4)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.4)GOTO12890
      WRITE(ICOUT,12825)RSD(5)
12825 FORMAT('CONSTANT & FACTOR  5 ONLY--',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.EQ.5)WRITE(ICOUT,12835)RESSD
12835 FORMAT('CONSTANT & ALL 5 FACTORS --',F20.10)
      IF(NUMFAC.EQ.5)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.5)GOTO12890
C
12890 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11811)
11811 FORMAT('                          *************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11812)
11812 FORMAT('                          *  TESTING  *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11811)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11815)
11815 FORMAT('             NUM. LEVELS    F STAT.',
     1'       F CDF ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11816)
11816 FORMAT('-----------------------------------',
     1'-------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11821)N1,FVAL(1),F1CDF2
11821 FORMAT('FACTOR  1--',I8,F20.11,F8.3,'%',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.1)GOTO11890
      WRITE(ICOUT,11822)N2,FVAL(2),F2CDF2
11822 FORMAT('FACTOR  2--',I8,F20.11,F8.3,'%',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.2)GOTO11890
      WRITE(ICOUT,11823)N3,FVAL(3),F3CDF2
11823 FORMAT('FACTOR  3--',I8,F20.11,F8.3,'%',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.3)GOTO11890
      WRITE(ICOUT,11824)N4,FVAL(4),F4CDF2
11824 FORMAT('FACTOR  4--',I8,F20.11,F8.3,'%',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.4)GOTO11890
      WRITE(ICOUT,11825)N5,FVAL(5),F5CDF2
11825 FORMAT('FACTOR  5--',I8,F20.11,F8.3,'%',F20.10)
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.LE.5)GOTO11890
C
11890 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,11611)RESSD
11611 FORMAT('      RESIDUAL    STANDARD DEVIATION = ',F20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11612)IRESDF
11612 FORMAT('      RESIDUAL    DEGREES OF FREEDOM = ',2X,I11)
      CALL DPWRST('XXX','BUG ')
C
      IF(IREP.EQ.'NO')GOTO11690
      WRITE(ICOUT,11621)REPSD
11621 FORMAT('      REPLICATION STANDARD DEVIATION = ',F20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11622)IREPDF
11622 FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I11)
      CALL DPWRST('XXX','BUG ')
C
      IF(IFITDF.GE.1)GOTO11661
      IF(NUMFAC.EQ.1)GOTO11690
      WRITE(ICOUT,11636)
11636 FORMAT('      LACK OF FIT F TEST CANNOT BE DONE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11637)
11637 FORMAT('      HAVE ONLY 0 DEGREES OF FREEDOM IN ',
     1'NUMERATOR OF F RATIO.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11638)
11638 FORMAT('      THIS HAPPENS WHEN NUMBER OF PARAMETERS ',
     1'FITTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11639)
11639 FORMAT('      IS IDENTICAL TO NUMBER OF DISTINCT ',
     1'SUBSETS.')
      CALL DPWRST('XXX','BUG ')
      GOTO11690
C
11661 CONTINUE
C
      WRITE(ICOUT,11640)FITFVA,FITCD2
11640 FORMAT('      LACK OF FIT F RATIO = ',F11.4,' = THE ',
     1F9.4,'% POINT OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11645)IFITDF,IREPDF
11645 FORMAT('      F DISTRIBUTION WITH ',I6,' AND ',I6,
     1' DEGREES OF FREEDOM')
      CALL DPWRST('XXX','BUG ')
C
11690 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMFAC
 9013 FORMAT('N,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGA3
 9014 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IREP
 9022 FORMAT('IREP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)REPSS,REPMS,REPSD,REPDF
 9023 FORMAT('REPSS,REPMS,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,N
      WRITE(ICOUT,9026)I,Y(I),F1(I),F2(I),W(I),PRED2(I),RES2(I)
 9026 FORMAT('I,Y(I),F1(I),F2(I),W(I),PRED2(I),RES2(I) = ',
     1I8,6E11.4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMEPO(IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A MEDIAN POLISH.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 Gaithersburg, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C                                            MOVE DIMENSIONING OF Y2 AND Z
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION F1(MAXOBV)
      DIMENSION F2(MAXOBV)
      DIMENSION F3(MAXOBV)
      DIMENSION F4(MAXOBV)
      DIMENSION F5(MAXOBV)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION W(MAXOBV)
C
      DIMENSION B(100)
      DIMENSION SDB(100)
      DIMENSION FCUM(100)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      DIMENSION Y2(MAXOBV)
      DIMENSION Z(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),F1(1))
      EQUIVALENCE (GARBAG(IGARB2),F2(1))
      EQUIVALENCE (GARBAG(IGARB3),F3(1))
      EQUIVALENCE (GARBAG(IGARB4),PRED2(1))
      EQUIVALENCE (GARBAG(IGARB5),RES2(1))
      EQUIVALENCE (GARBAG(IGARB6),Y2(1))
      EQUIVALENCE (GARBAG(IGARB7),Z(1))
      EQUIVALENCE (GARBAG(IGARB8),B(1))
      EQUIVALENCE (GARBAG(IGARB8+100),SDB(1))
      EQUIVALENCE (GARBAG(IGARB8+200),FCUM(1))
CCCCC END CHANGE
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      EQUIVALENCE (W(1),X3D(1))
      EQUIVALENCE (F5(1),X(1))
      EQUIVALENCE (F4(1),D(1))
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPME'
      ISUBN2='PO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MAXV2=6
      MINN2=2
C
      MAXFAC=MAXV2-1
C
      ICASEQ='UNKN'
C
C               ************************************
C               **  TREAT THE MEDIAN POLISH CASE  **
C               ************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMEPO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'MEDI'.AND.
     1IHARG(1).EQ.'POLI')GOTO111
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPMEPO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A MEDIAN POLISH ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      NLEFT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,319)(IANS(I),I=1,IWIDTH)
  319 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************
C               **  STEP 6--                            **
C               **  CHECK FOR A VALID NUMBER            **
C               **  OF INDEPENDENT VARIABLES (1 TO 5).  **
C               **  CHECK THE VALIDITY OF EACH          **
C               **  OF THE INDEPENDENT VARIABLES        **
C               **  (THAT IS, OF EACH OF THE FACTORS).  **
C               **  DOES THE NAME EXIST IN THE TABLE?   **
C               **  DOES THE NUMBER OF ELEMENTS         **
C               **  AGREE WITH THE NUMBER OF ELEMENTS   **
C               **  IN THE RESPONSE VARIABLE?           **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMFAC=ILOCQ-2
      IF(1.LE.NUMFAC.AND.NUMFAC.LE.MAXFAC)GOTO520
C
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPMEPO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A MEDIAN POLISH,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,513)
  513 FORMAT('      THE NUMBER OF INDEPENDENT VARIABLES (FACTORS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,514)MAXFAC
  514 FORMAT('      MUST BE AT LEAST 1 AND AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,515)
  515 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,516)
  516 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,517)NUMFAC
  517 FORMAT('      OF INDEPENDENT VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,519)(IANS(I),I=1,IWIDTH)
  519 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  520 CONTINUE
      DO530IFAC=1,NUMFAC
      J=IFAC+1
      IHFACT=IHARG(J)
      IHFAC2=IHARG2(J)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLIV(IFAC)=IVALUE(ILOCV)
      NIV(IFAC)=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,532)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),
     1NIV(IFAC)
  532 FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),NIV(IFAC) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      DO540IFAC=1,NUMFAC
      IF(NIV(IFAC).NE.NLEFT)GOTO550
  540 CONTINUE
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPMEPO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A MEDIAN POLISH,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      IN EACH INDEPENDENT VARIABLE (FACTOR)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SHOULD BE THE SAME AS THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      IN THE DEPENDENT VARIABLE (RESPONSE);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      DEPENDENT   VARIABLE  (RESPONSE)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)IHLEFT,IHLEF2,NLEFT
  562 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      INDEPENDENT VARIABLES (FACTORS)--')
      CALL DPWRST('XXX','BUG ')
      DO565IFAC=1,NUMFAC
      J=IFAC+1
      WRITE(ICOUT,566)IHARG(J),IHARG2(J),NIV(IFAC)
  566 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  565 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,567)
  567 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,568)(IANS(I),I=1,IWIDTH)
  568 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
      IFAC=1
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F1(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F1(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F1(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F1(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F1(J)=TAGPLO(I)
      IF(NUMFAC.LE.1)GOTO660
C
      IFAC=2
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F2(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F2(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F2(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F2(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F2(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F2(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F2(J)=TAGPLO(I)
      IF(NUMFAC.LE.2)GOTO660
C
      IFAC=3
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F3(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F3(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F3(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F3(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F3(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F3(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F3(J)=TAGPLO(I)
      IF(NUMFAC.LE.3)GOTO660
C
      IFAC=4
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F4(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F4(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F4(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F4(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F4(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F4(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F4(J)=TAGPLO(I)
      IF(NUMFAC.LE.4)GOTO660
C
      IFAC=5
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F5(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F5(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F5(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F5(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F5(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F5(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F5(J)=TAGPLO(I)
      IF(NUMFAC.LE.5)GOTO660
C
  660 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPMEP2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO680I=1,NS
      W(I)=1.0
  680 CONTINUE
C
C               ***********************************
C               **  STEP 9--                     **
C               **  CARRY OUT THE MEDIAN POLISH  **
C               ***********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO790
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,711)
  711 FORMAT('***** FROM DPMEPO, AS WE ARE ABOUT TO CALL DPMEP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMFAC
  712 FORMAT('NLEFT,MAXN,NS,NUMFAC = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO715I=1,NS
      WRITE(ICOUT,716)I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I)
  716 FORMAT('I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I) = ',
     1I6,2X,7F10.5)
      CALL DPWRST('XXX','BUG ')
  715 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,731)IBUGA3
  731 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
  790 CONTINUE
C
CCCCC JUNE, 1990.  MOVE DIMENSIONING OF Y2 AND Z TO DPMEPO (RATHER THAN
CCCCC DPMEP2).
      CALL DPMEP2(Y,F1,F2,F3,F4,F5,W,NS,NUMFAC,
     1B,SDB,FCUM,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1Y2,Z,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
      IREPU='ON'
      IRESU='ON'
      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMEPO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NS,NUMFAC
 9014 FORMAT('NS,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMESS(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE DATAPLOT MESSAGES
C              FOR THE ANALYST'S PERUSAL UPON
C              SIGNING ON TO DATAPLOT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1979.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ISTRIN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPME'
      ISUBN2='SS  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMESS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IMESNU
   61 FORMAT('IMESNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IMESNA
   62 FORMAT('IMESNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IMESST
   63 FORMAT('IMESST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IMESFO
   64 FORMAT('IMESFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IMESAC
   65 FORMAT('IMESAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IMESFO
   66 FORMAT('IMESFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IMESCS
   67 FORMAT('IMESCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IMESNU
      IFILE=IMESNA
      ISTAT=IMESST
      IFORM=IMESFO
      IACCES=IMESAC
      IPROT=IMESPR
      ICURST=IMESCS
C
      ISUBN0='MESS'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK TO SEE IF MESSAGE FILE EXISTS  **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO9000
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************
C               **  STEP 41--               **
C               **  READ THE FILE.          **
C               **  WRITE OUT THE MESSAGES. **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ANUMLI=0.0
      READ(IOUNIT,4111,END=4190)ANUMLI
 4111 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
C
      IF(NUMLIN.LE.0)GOTO4190
      DO4120I=1,NUMLIN
      READ(IOUNIT,4121,END=4190)(ISTRIN(J:J),J=1,80)
 4121 FORMAT(80A1)
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4122)(ISTRIN(J:J),J=1,JMAX)
 4122 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4190 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'MESS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMESS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)JMAX
 9041 FORMAT('JMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(JMAX.GE.1)WRITE(ICOUT,9042)(ISTRIN(J:J),J=1,JMAX)
 9042 FORMAT('ISTRIN--',80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMFCO(IHARG,NUMARG,IDEMFC,MAXMAR,IMAFCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER FILL COLORS = THE COLORS
C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMFC
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAFCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMFC
      CHARACTER*4 IMAFCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMF'
      ISUBN2='CO  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMFC
   55 FORMAT('IDEMFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAFCO(1)
   70 FORMAT('IMAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAFCO(I)
   76 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAFCO(1)=IDEMFC
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
      IMAFCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAFCO(I)
 1276 FORMAT('THE FILL COLOR OF MARKER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFC
      DO1315I=1,NUMMAR
      IMAFCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAFCO(I)
 1316 FORMAT('THE FILL COLOR OF ALL MARKERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMFC
 9015 FORMAT('IDEMFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAFCO(1)
 9030 FORMAT('IMAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAFCO(I)
 9036 FORMAT('I,IMAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMFSW(IHARG,NUMARG,IDEMFS,MAXMAR,IMAFSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE MARKER FILL SWITCHES = THE ON/OFF SWITCHES
C              OF THE (BACKGROUND) FILL WITHIN THE MARKERS.
C              THESE ARE LOCATED IN THE VECTOR IMAFSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEMFS
C                     --MAXMAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IMAFSW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEMFS
      CHARACTER*4 IMAFSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IMAFSW(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPMF'
      ISUBN2='SW  '
C
      NUMMAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPMFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXMAR,NUMMAR
   53 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEMFS
   55 FORMAT('IDEMFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IMAFSW(1)
   70 FORMAT('IMAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IMAFSW(I)
   76 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMMAR=1
      IMAFSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMMAR=NUMARG-2
      IF(NUMMAR.GT.MAXMAR)NUMMAR=MAXMAR
      DO1225I=1,NUMMAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
      IMAFSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMMAR
      WRITE(ICOUT,1276)I,IMAFSW(I)
 1276 FORMAT('THE FILL SWITCH FOR MARKER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMMAR=MAXMAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEMFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEMFS
      DO1315I=1,NUMMAR
      IMAFSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IMAFSW(I)
 1316 FORMAT('THE FILL SWITCH FOR ALL MARKERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPMFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXMAR,NUMMAR
 9013 FORMAT('MAXMAR,NUMMAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEMFS
 9015 FORMAT('IDEMFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IMAFSW(1)
 9030 FORMAT('IMAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IMAFSW(I)
 9036 FORMAT('I,IMAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPMGET(Y,X,N,NVAR,
     1TEMP1,TEMP2,TEMP3,DTEMP1,
     1AMUMOM,BETAMO,AMUFR,BETAFR,AMUML,BETAML,
     1ICAPSW,ICAPTY,MAXNXT,
     1IGETDF,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE GEETA DISTRIBUTION.  ESTIMATES
C              ARE GENERATED IN TERMS OF THE MU/BETA
C              PARAMETERIZATION.
C
C              THE MOMENT ESTIMATES OF MU AND BETA ARE:
C
C                 MUHAT = XBAR
C                 BETAHAT = (S**2 - XBAR*(XBAR-1))/
C                           (S**2 - XBAR**2*(XBAR-1))
C
C              THE MEAN AND ONES FREQUENCY ESTIMATE OF MU IS:
C
C                  MUHAT = XBAR
C
C              THE ESTIMATE OF BETA IS THEN THE SOLUTION OF THE
C              EQUATION
C
C                 ((BETA-1)*XBAR/(BETA*XBAR-1))**(BETA-1) - (N1/N) = 0
C
C              THE MAXIMUM LIKELIHOOD FREQUENCY ESTIMATE OF MU IS:
C
C                  MUHAT = XBAR
C
C              THE ESTIMATE OF BETA IS THEN THE SOLUTION OF THE
C              EQUATION
C
C                 ((BETA-1)*XBAR/(BETA*XBAR-1))**(BETA-1) - 
C                 (1/(N*XBAR))*
C                 SUM[X=2 to k][SUM[i=2 to k][X*N(x)/(BETA*X-1)]] = 0
C
C              THERE ARE TWO CASES:
C
C              1) ONE VARIABLE CASE: Y IS RAW DATA
C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
C                 MID-POINT.
C
C     EXAMPLE--GEETA MAXIMUM LIKELIHOOD Y
C            --GEETA MAXIMUM LIKELIHOOD Y X
C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 8.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/7
C     ORIGINAL VERSION--JULY      2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGETDF
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
C-------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
      DOUBLE PRECISION XMID
      DOUBLE PRECISION DALPHA
C
      DOUBLE PRECISION GETFUN
      DOUBLE PRECISION GETFU2
      EXTERNAL GETFUN
      EXTERNAL GETFU2
      DOUBLE PRECISION XBAR
      DOUBLE PRECISION S2
      DOUBLE PRECISION F1FREQ
      COMMON/GETCOM/XBAR,S2,F1FREQ,MAXROW,NTOT2
C
C-------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT---------------------------------------------------
C
      ISUBN1='DPMG'
      ISUBN2='ET  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGET')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMGET--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NVAR
   55   FORMAT('N,NVAR = ',2I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),X(I)
   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GEETA ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NVAR.EQ.1)THEN
        HOLD=Y(1)
        DO1135I=2,N
          IF(Y(I).NE.HOLD)GOTO1139
 1135   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1131)
 1131   FORMAT('***** ERROR IN GEETA MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1133)HOLD
 1133   FORMAT('      HAS ALL ELEMENTS = ',E15.7)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
 1139   CONTINUE
C
        DO1145I=1,N
          IF(Y(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1131)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1148)I,Y(I)
 1148       FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',
     1             G15.7,')')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 1145   CONTINUE
C
        CALL SORT(Y,N,TEMP2)
        DO1160I=1,N
          Y(I)=TEMP2(I)
 1160   CONTINUE
C
        IRELAT='OFF'
        IRHSTG='OFF'
        XMIN=Y(1)
        XMAX=Y(N)
        XSTART=XMIN-0.5
        XSTOP=XMAX+0.5
        CLWID=1.0
        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1              TEMP2,TEMP1,N2,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IINDX=MAXNXT/2
        IF(N2.LE.IINDX)THEN
          IML=0
          ICNT=0
          DO101I=1,N2
CCCCC       IF(TEMP2(I).GT.0)THEN
              ICNT=ICNT+1
              TEMP2(ICNT)=TEMP2(I)
              TEMP1(ICNT)=TEMP1(I)
              TEMP3(I)=TEMP2(I)
              TEMP3(IINDX+I)=TEMP3(I)
CCCCC       ENDIF
 101      CONTINUE
          N2=ICNT
          IK=N2
        ELSE
          IML=1
        ENDIF
        F1=TEMP2(1)/REAL(N)
C
      ELSEIF(NVAR.EQ.2)THEN
        CALL SORTC(X,Y,N,TEMP1,TEMP2)
        NTOT=0
        DO1210I=1,N
          X(I)=TEMP1(I)
          Y(I)=TEMP2(I)
          NTOT=NTOT + Y(I)
 1210   CONTINUE
        F1=Y(1)/REAL(NTOT)
C
        DO1220I=1,N
          IF(Y(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1131)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1223)
 1223       FORMAT('      A NEGATIVE FREQUENCY WAS SPECIFIED.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1225)I,Y(I)
 1225       FORMAT('      ROW ',I8,' (AFTER SORTING) HAS FREQUENCY ',
     1             G15.7)
            CALL DPWRST('XXX','WRIT')
          ENDIF
 1220   CONTINUE
      ENDIF
C
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGET')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1301)N
 1301   FORMAT('AFTER SORT, N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO1310I=1,MAX(N,100)
          WRITE(ICOUT,1311)I,X(I),Y(I)
 1311     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
 1310   CONTINUE
      ENDIF
C
C               *********************************************
C               **  STEP 21--                              **
C               **  CARRY OUT CALCULATIONS                 **
C               **  FOR GEETA MLE                          **
C               **  ESTIMATION                             **
C               *********************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGET')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      IF(NVAR.EQ.1)THEN
        NTOT=N
        DO2105I=1,N
          ITEMP=INT(Y(I)+0.5)
          Y(I)=REAL(ITEMP)
 2105   CONTINUE
        CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
        CALL SD(Y,N,IWRITE,ASD,IBUGA3,IERROR)
        AMIN=Y(1)
        AMAX=Y(N)
C
      ELSE
        AMIN=X(1)
        AMAX=X(N)
        CALL WEMEAN(X,Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
        CALL WESD(X,Y,N,IWRITE,ASD,IBUGA3,IERROR)
        IINDX=MAXNXT/2
        IF(N.LE.IINDX)THEN
          IML=0
          DO2210I=1,N
            NTOT=NTOT+Y(I)
            TEMP3(I)=Y(I)
            TEMP3(IINDX+I)=X(I)
 2210     CONTINUE
          IK=N
        ELSE
          IML=1
        ENDIF
      ENDIF
C
      AVAR=ASD**2
      ACUT=AMEAN**2*(AMEAN-1.0)
      IF(AVAR.LE.ACUT)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2223)
 2223   FORMAT('      IN ORDER FOR THE GEETA DISTRIBUTION TO BE ',
     1         'APPLICABLE,')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2225)
 2225   FORMAT('         S**2 > XBAR**2*(XBAR - 1)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2227)
 2227   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2228)AMEAN
 2228   FORMAT('      SAMPLE MEAN     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2229)AVAR
 2229   FORMAT('      SAMPLE VARIANCE = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        GOTO9000
      ENDIF
C
      AMUMOM=AMEAN
      BETAMO=(AVAR - AMEAN*(AMEAN-1.0))/(AVAR - AMEAN**2*(AMEAN-1.0))
      AMUFR=AMEAN
      BETAFR=0.0
      AMUML=AMEAN
      BETAML=0.0
C
      AE=1.D-7
      RE=1.D-7
      XBAR=DBLE(AMEAN)
      S2=DBLE(ASD)**2
      F1FREQ=DBLE(F1)
      XMID=DBLE(BETAMO)
      XLOW=1.000001D0
      XUP=XMID + 10.0D0
      CALL DFZERO(GETFUN,XLOW,XUP,XMID,RE,AE,IFLAG)
      BETAFR=REAL(XLOW)
C
      IOPT=2
      TOL=1.0D-5
      NPAR=1
      NPRINT=-1
      INFO=0
      LWA=MAXNXT
      MAXROW=MAXNXT
      NTOT2=NTOT
C
      XPAR(1)=DBLE(BETAMO)
      CALL DNSQE(GETFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1             DTEMP1,LWA,TEMP3,IK)
C
      BETAML=REAL(XPAR(1))
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR GEETA MLE                           **
C               **   ESTIMATION                              **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
')
 5011   FORMAT('
    ')
 5013   FORMAT('')
 5015   FORMAT('   ')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   ')
 5043   FORMAT('      ')
 5049   FORMAT('      ')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)F1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,5068)
        ELSE
          WRITE(ICOUT,5168)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMUMOM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETAMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,5068)
        ELSE
          WRITE(ICOUT,5168)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMUFR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETAFR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,5068)
        ELSE
          WRITE(ICOUT,5168)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMUML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETAML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('
    ')
 5017   FORMAT('      Geeta Parameter Estimation ')
 5019   FORMAT('   
    ')
 5044   FORMAT('      ')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         First Frequency:')
 5068   FORMAT('         Estimate of Theta:')
 5168   FORMAT('         Estimate of Mu:')
 5069   FORMAT('         Estimate of Beta:')
 5071   FORMAT('         Method of Moments:')
 5072   FORMAT('         Method of Ones Frequency and Mean:')
 5073   FORMAT('         Maximum Likelihood:')
 5047   FORMAT('      ')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('          ')
 5056   FORMAT('             ')
 5059   FORMAT('   
    ')
 5093   FORMAT('
')
 5099   FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Geeta ',
     1       'Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'First Frequency: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Theta: & ',
     1       G15.7,2X,A1,A1)
 8129 FORMAT(5X,'Estimate of Mu: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Beta: & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Method of Moments: & ',2X,A1,A1)
 8032 FORMAT(5X,'Method of Ones Frequency and Mean: & ',
     1       2X,A1,A1)
 8033 FORMAT(5X,'Method of Maximum Likelihood: & ',
     1       2X,A1,A1)
 8039 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)AMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)AMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)F0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,8029)AMUMOM,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8129)AMUMOM,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,8029)AMUFR,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8129)AMUFR,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAFR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,8029)AMUML,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8129)AMUML,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(10X,
     1  'GEETA MAXIMUM LIKELIHOOD ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)AMEAN
 4222   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)ASD  
 4223   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)AMIN  
 4225   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)AMAX  
 4227   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)F1
 4229   FORMAT('FIRST FREQUENCY:                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)
 4231   FORMAT('METHOD OF MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,4235)AMUMOM
        ELSE
          WRITE(ICOUT,4236)AMUMOM
        ENDIF
 4235   FORMAT('ESTIMATE OF THETA                        = ',G15.7)
 4236   FORMAT('ESTIMATE OF MU                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)BETAMO
 4237   FORMAT('ESTIMATE OF BETA                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('METHOD OF ONES FREQUENCY AND MEAN:')
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,4235)AMUFR
        ELSE
          WRITE(ICOUT,4236)AMUFR
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)BETAFR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4251)
 4251   FORMAT('MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        IF(IGETDF.EQ.'THET')THEN
          WRITE(ICOUT,4235)AMUML
        ELSE
          WRITE(ICOUT,4236)AMUML
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)BETAML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4291)
 4291   FORMAT('ESTIMATES ARE SAVED IN THE INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4292)
 4292   FORMAT('THETAMOM, BETAMOM, THETAFR, BETAFR, THETAML, ',
     1         'AND BETAML')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGET')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMGET--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMGNB(Y,X,N,NVAR,
     1TEMP1,TEMP2,TEMP3,DTEMP1,
     1THETMO,BETAMO,AMMOM,
     1THETFR,BETAFR,AMFR,
     1THETF2,BETAF2,AMF2,
     1THETML,BETAML,AMML,
     1ICAPSW,ICAPTY,MAXNXT,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR THE GENERALIZED NEGATIVE BINOMIAL
C              DISTRIBUTION.
C
C              THE MOMENT ESTIMATE OF THETA IS THE SOLUTION
C              OF THE EQUATION:
C
C                 THETAHAT = 1 - 0.5*A + (A**2/4 - 1)**(0.5)
C                 A = -2 + (XBAR*S3 - 3*S2**2)**2/(XBAR*S2**3)
C
C                 BETAHAT = {1 - SQRT(XBAR*(1-THETAHAT)/S2)}/THETAHAT
C                 MHAT = XBAR*(1-THETAHAT*BETAHAT)/THETAHAT
C
C                 S2 = SAMPLE VARIANCE
C                 S3 = SAMPLE THIRD SAMPLE MOMENT
C                      (SUM[i=0 to k][N(i)*(i-XBAR)**3/(N-1) =
C                       SUM[j=1 to n][(X(j) - XBAR)**2]
C                      
C              THE MOMENTS AND ZERO FREQUENCY ESTIMATE OF THETA
C              IS THE SOLUTION OF THE EQUATION
C
C                 S2*(LOG(F0)**2/XBAR**3 -
C                 (1-THETA)*(LOG(1-THETA))**2/THETA**2 = 0
C
C                 MHAT = SQRT{(1-THETAHAT)*XBAR**3/S2}/THETAHAT
C                 BETAHAT = (1/THETAHAT) - MHAT/XBAR
C
C
C              THE MOMENTS AND RATIO OF FREQUENCIES ESTIMATE OF
C              THETA IS THE SOLUTION OF THE EQUATION
C
C                 {(2/THETA) - (2/THETA)*SQRT(XBAR*(1-THETA)/S2)-1}*
C                 LOG(1-THETA) - LOG(S2*F10**2/XBAR**3) = 0
C
C                 F10 = F1/F0
C
C                 MHAT = SQRT{(1-THETAHAT)*XBAR**3/S2}/THETA
C                 BETAHAT = (1/THETAHAT) - MHAT/XBAR
C                  
C              THE MAXIMUM LIKELIHOOD ESTIMATES ARE THE SOLUTIONS
C              TO THE EQUATIONS:
C
C                 (N-N0)*XBAR/M - SUM[X=2 to k][SUM[i=1 to x-1]
C                 [(X-XBAR)*N(x)/(M+BETA*X-i]] = 0
C
C                 N*XBAR*LOG(1-XBAR/(M+BETA*XBAR)) +
C                 SUM[X=2 to k][SUM[i=1 to x-1]
C                 [X*N(x)/(M+BETA*X-i]] = 0
C
C                 THETAHAT = XBAR/(MHAT+BETA*XBAR)
C
C              THERE ARE TWO CASES:
C
C              1) ONE VARIABLE CASE: Y IS RAW DATA
C              2) TWO VARIABLE CASE: Y IS FREQUENCY, X IS CLASS
C                 MID-POINT.
C
C     EXAMPLE--GENERALIZED NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y
C            --GENERALIZED NEGATIVE BINOMIAL MAXIMUM LIKELIHOOD Y X
C     REFERENCES--CONSUL AND FAMOYE (2006), "LAGRANGIAN PROBABILITY
C                 DISTRIBUTIONS", BIRKHAUSER, CHAPTER 10.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBUG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/7
C     ORIGINAL VERSION--JULY      2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-----------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 IRELAT
      CHARACTER*4 IRHSTG
C
C-------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DOUBLE PRECISION DTEMP1(*)
C
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(3)
      DOUBLE PRECISION FVEC(3)
C
      DOUBLE PRECISION AE
      DOUBLE PRECISION RE
      DOUBLE PRECISION XLOW
      DOUBLE PRECISION XUP
      DOUBLE PRECISION XMID
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DA
C
      DOUBLE PRECISION GNBFUN
      DOUBLE PRECISION GNBFU3
      DOUBLE PRECISION GNBFU4
      EXTERNAL GNBFUN
      EXTERNAL GNBFU2
      EXTERNAL GNBFU3
      EXTERNAL GNBFU4
      DOUBLE PRECISION XBAR
      DOUBLE PRECISION S2
      DOUBLE PRECISION S3
      DOUBLE PRECISION F0FREQ
      DOUBLE PRECISION F1FREQ
      DOUBLE PRECISION F10FRE
      DOUBLE PRECISION DC1
      COMMON/GNBCOM/XBAR,S2,S3,F0FREQ,F1FREQ,F10FRE,DC1,
     1              MAXROW,NTOT2
C
C-------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT---------------------------------------------------
C
      ISUBN1='DPMG'
      ISUBN2='NB  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGNB')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPMGNB--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NVAR
   55   FORMAT('N,NVAR = ',2I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),X(I)
   57     FORMAT('I,Y(I),X(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGNB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GENERALIZED NEGATIVE BINOMIAL ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      THE NUMBER OF OBSERVATIONS ',
     1         'FOR VARIABLE 1 IS LESS THAN 3')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1115)N
 1115   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NVAR.EQ.1)THEN
        HOLD=Y(1)
        DO1135I=2,N
          IF(Y(I).NE.HOLD)GOTO1139
 1135   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1131)
 1131   FORMAT('***** ERROR IN GENERALIZED NEGATIVE BINOMIAL ',
     1         'MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1133)HOLD
 1133   FORMAT('      HAS ALL ELEMENTS = ',E15.7)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
 1139   CONTINUE
C
        DO1145I=1,N
          IF(Y(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1147)
 1147       FORMAT('***** ERROR IN GENERALIZED NEGATIVE BINOMIAL ',
     1             'MAXIMUM LIKELIHOOD ESTIMATION')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1148)I,Y(I)
 1148       FORMAT('      ROW ',I8,' IS NON-POSITIVE (VALUE = ',
     1             G15.7,')')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
 1145   CONTINUE
C
        CALL SORT(Y,N,TEMP2)
        DO1160I=1,N
          Y(I)=TEMP2(I)
 1160   CONTINUE
C
        IRELAT='OFF'
        IRHSTG='OFF'
        XMIN=Y(1)
        XMAX=Y(N)
        XSTART=XMIN-0.5
        XSTOP=XMAX+0.5
        CLWID=1.0
        CALL DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1              TEMP2,TEMP1,N2,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IINDX=MAXNXT/2
        IF(N2.LE.IINDX)THEN
          IML=0
          ICNT=0
          DO101I=1,N2
CCCCC       IF(TEMP2(I).GT.0)THEN
              ICNT=ICNT+1
              TEMP2(ICNT)=TEMP2(I)
              TEMP1(ICNT)=TEMP1(I)
              TEMP3(I)=TEMP2(I)
              TEMP3(IINDX+I)=TEMP1(I)
CCCCC       ENDIF
 101      CONTINUE
          N2=ICNT
          IK=N2
        ELSE
          IML=1
        ENDIF
        F0=TEMP2(1)/REAL(N)
        F1=TEMP2(2)/REAL(N)
        IF(F0.NE.0.0)THEN
          F10=F1/F0
        ELSE
          F10=CPUMIN
        ENDIF
C
      ELSEIF(NVAR.EQ.2)THEN
        CALL SORTC(X,Y,N,TEMP1,TEMP2)
        NTOT=0
        DO1210I=1,N
          X(I)=TEMP1(I)
          Y(I)=TEMP2(I)
          NTOT=NTOT + Y(I)
 1210   CONTINUE
        F0=Y(1)/REAL(NTOT)
        F1=Y(2)/REAL(NTOT)
        IF(F0.NE.0.0)THEN
          F10=F1/F0
        ELSE
          F10=CPUMIN
        ENDIF
C
        DO1220I=1,N
          IF(Y(I).LT.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1221)
 1221       FORMAT('***** ERROR IN GENERALIZED NEGATIVE BINOMIAL ',
     1             'MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1223)
 1223       FORMAT('      A NEGATIVE FREQUENCY WAS SPECIFIED.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1225)I,Y(I)
 1225       FORMAT('      ROW ',I8,' (AFTER SORTING) HAS FREQUENCY ',
     1             G15.7)
            CALL DPWRST('XXX','WRIT')
          ENDIF
 1220   CONTINUE
      ENDIF
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGNB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1301)N
 1301   FORMAT('AFTER SORT, N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO1310I=1,MAX(N,100)
          WRITE(ICOUT,1311)I,X(I),Y(I)
 1311     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','WRIT')
 1310   CONTINUE
      ENDIF
C
C               *********************************************
C               **  STEP 21--                              **
C               **  CARRY OUT CALCULATIONS                 **
C               **  FOR GENERALIZED NEGATIVE BINOMIAL MLE  **
C               **  ESTIMATION                             **
C               *********************************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGNB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
C
      IF(NVAR.EQ.1)THEN
        NTOT=N
        DO2105I=1,N
          ITEMP=INT(Y(I)+0.5)
          Y(I)=REAL(ITEMP)
 2105   CONTINUE
        CALL MEAN(Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
        CALL SD(Y,N,IWRITE,ASD,IBUGA3,IERROR)
        AVAR=ASD**2
        AMIN=Y(1)
        AMAX=Y(N)
        DSUM=0.0D0
        DO2108I=1,N
          DTERM1=DBLE(Y(I)) - DBLE(AMEAN)
          DSUM=DSUM +  DTERM1**3
 2108   CONTINUE
        S3=REAL(DSUM/DBLE(N-1))
C
      ELSE
        AMIN=X(1)
        AMAX=X(N)
        CALL WEMEAN(X,Y,N,IWRITE,AMEAN,IBUGA3,IERROR)
        CALL WESD(X,Y,N,IWRITE,ASD,IBUGA3,IERROR)
        AVAR=ASD**2
        IINDX=MAXNXT/2
        IF(N.LE.IINDX)THEN
          IML=0
          DO2210I=1,N
            NTOT=NTOT+Y(I)
            TEMP3(I)=Y(I)
            TEMP3(IINDX+I)=X(I)
 2210     CONTINUE
          IK=N
        ELSE
          IML=1
        ENDIF
        DSUM=0.0D0
        DO2208I=1,N
          DSUM=DSUM +  DBLE(Y(I))*(DBLE(I) - DBLE(AMEAN))**3
 2208   CONTINUE
        S3=REAL(DSUM/DBLE(NTOT-1))
      ENDIF
C
      THETMO=0.0
      BETAMO=0.0
      AMMOM=0.0
      THETFR=0.0
      BETAFR=0.0
      AMFR=0.0
      THETF2=0.0
      BETAF2=0.0
      AMF2=0.0
      THETML=0.0
      BETAML=0.0
      AMML=0.0
C
      XBAR=DBLE(AMEAN)
      S2=DBLE(ASD)**2
      DA=-2.0D0 + (XBAR*S3 - 3.0D0*S2**2)**2/(XBAR*S2**3)
      THETMO=REAL(1.0D0 - 0.5D0*DA + DSQRT(DA**2/4.0D0 - 1.0D0))
      BETAMO=(1.0 - SQRT(XBAR*(1.0-THETMO)/S2))/THETMO
      IF(BETAMO.LE.1.0)BETAMO=1.0
      AMMOM=XBAR*(1.0-THETMO*BETAMO)/THETMO
C
      AE=1.D-7
      RE=1.D-7
      XLOW=0.000001D0
      XUP=0.999999D0
      XMID=0.5D0
      F0FREQ=DBLE(F0)
      F1FREQ=DBLE(F1)
      F10FRE=DBLE(F10)
      NTOT2=NTOT
C
      IFR=0
      IF(F0.GT.0.0)THEN
        C1=S2*LOG(F0)**2/(XBAR**3)
        IF(C1.GE.1.0 .OR. C1.LE.0.0)IFR=1
      ELSE
        IFR=1
      ENDIF
      IF(IFR.EQ.0)THEN
        DC1=DBLE(C1)
        XLOW=0.000001D0
        XUP=0.999999D0
        XMID=DBLE(THETMO)
        CALL DFZERO(GNBFU3,XLOW,XUP,XMID,RE,AE,IFLAG)
        THETFR=REAL(XLOW)
        AMFR=SQRT((1.0-THETFR)*AMEAN**3/AVAR)/THETFR
        BETAFR=(1.0/THETFR) - (AMFR/AMEAN)
        IF(BETAFR.LE.1.0)BETAFR=1.0
      ENDIF
C
      IFR2=0
      XLOW=0.000001D0
      XUP=0.999999D0
      DTERM1=GNBFU4(XLOW)
      DTERM2=GNBFU4(XUP)
      IF(DTERM1*DTERM2.GT.0.0D0)THEN
        IFR2=1
      ENDIF
      IF(IFR2.EQ.0)THEN
        XMID=DBLE(THETMO)
        CALL DFZERO(GNBFU4,XLOW,XUP,XMID,RE,AE,IFLAG)
        THETF2=REAL(XLOW)
        AMF2=SQRT((1.0-THETF2)*AMEAN**3/AVAR)/THETF2
        BETAF2=(1.0/THETF2) - (AMF2/AMEAN)
        IF(BETAF2.LE.1.0)BETAF2=1.0
      ENDIF
C
      IF(IML.EQ.0)THEN
        IOPT=2
        TOL=1.0D-5
        NPAR=3
        NPRINT=-1
        INFO=0
        LWA=MAXNXT
        MAXROW=MAXNXT
C
        IF(IFR2.EQ.0)THEN
          XPAR(1)=DBLE(BETAF2)
          XPAR(2)=DBLE(AMF2)
          XPAR(3)=DBLE(THETF2)
        ELSEIF(IFR.EQ.0)THEN
          XPAR(1)=DBLE(BETAFR)
          XPAR(2)=DBLE(AMFR)
          XPAR(3)=DBLE(THETFR)
        ELSE
          XPAR(1)=DBLE(BETAMO)
          XPAR(2)=DBLE(BETAMO)
          XPAR(3)=DBLE(THETMO)
        ENDIF
        CALL DNSQE(GNBFU2,JAC,IOPT,NPAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1             DTEMP1,LWA,TEMP3,IK)
C
        BETAML=REAL(XPAR(1))
        AMML=REAL(XPAR(2))
        THETML=REAL(XPAR(3))
      ENDIF
C
C               ***********************************************
C               **   STEP 42--                               **
C               **   WRITE OUT EVERYTHING                    **
C               **   FOR GENERALIZED NEGATIVE BINOMIAL MLE   **
C               **   ESTIMATION                              **
C               ***********************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNM')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
')
 5011   FORMAT('
    ')
 5013   FORMAT('')
 5015   FORMAT('   ')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   ')
 5043   FORMAT('      ')
 5049   FORMAT('      ')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)ASD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)F0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THETMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETAMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THETFR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)BETAFR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)THETML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)PWD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('
    ')
 5017   FORMAT('      Lagrange-Poisson Parameter Estimation ')
 5019   FORMAT('   
    ')
 5044   FORMAT('      ')
 5045   FORMAT('         Number of Observations:')
 5061   FORMAT('         Sample Mean:')
 5062   FORMAT('         Sample Standard Deviation:')
 5063   FORMAT('         Sample Minimum:')
 5064   FORMAT('         Sample Maximum:')
 5065   FORMAT('         First Frequency:')
 5068   FORMAT('         Estimate of Theta:')
 5069   FORMAT('         Estimate of Beta:')
 5071   FORMAT('         Method of Moments:')
 5072   FORMAT('         Method of Ones Frequency and Mean:')
 5073   FORMAT('         Maximum Likelihood:')
 5047   FORMAT('      ')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('          ')
 5056   FORMAT('             ')
 5059   FORMAT('   
    ')
 5093   FORMAT('
')
 5099   FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5099)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER,
C          AND WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Lagrange-Poisson ',
     1       'Parameter Estimation}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Sample Minimum: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Sample Maximum: & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'First Frequency: & ',G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Estimate of Theta: & ',
     1       G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Estimate of Beta: & ',
     1       G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Method of Moments: & ',2X,A1,A1)
 8032 FORMAT(5X,'Method of Ones Frequency and Mean: & ',
     1       2X,A1,A1)
 8033 FORMAT(5X,'Method of Maximum Likelihood: & ',
     1       2X,A1,A1)
 8039 FORMAT(5X,' & ',2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)AMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)ASD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)AMIN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)AMAX,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)F0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)THETMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAMO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)THETFR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAFR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8039)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)THETML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)BETAML,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
 8099 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8099)IBASLC
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(10X,
     1  'GENERALIZED NEGATIVE BINOMIAL PARAMETER ESTIMATION:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N
 4221   FORMAT('NUMBER OF OBSERVATIONS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)AMEAN
 4222   FORMAT('SAMPLE MEAN                              = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)ASD  
 4223   FORMAT('SAMPLE STANDARD DEVIATION                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)REAL(S3)  
 4224   FORMAT('SAMPLE CENTRALIZED THIRD MOMENT          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)AMIN  
 4225   FORMAT('SAMPLE MINIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)AMAX  
 4227   FORMAT('SAMPLE MAXIMUM                           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4228)F0
 4228   FORMAT('ZERO-CLASS FREQUENCY:                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)F1
 4229   FORMAT('ONES-CLASS FREQUENCY:                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4230)F10
 4230   FORMAT('RATIO OF ONES- AND ZERO-FREQUENCIES:     = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)
 4231   FORMAT('METHOD OF MOMENTS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4235)THETMO
 4235   FORMAT('ESTIMATE OF THETA                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)BETAMO
 4237   FORMAT('ESTIMATE OF BETA                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4239)AMMOM
 4239   FORMAT('ESTIMATE OF M                            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(IFR.EQ.0)THEN
          WRITE(ICOUT,4241)
 4241     FORMAT('METHOD OF ZERO-CLASS FREQUENCY AND MOMENTS:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4235)THETFR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4237)BETAFR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4239)AMFR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(IFR.EQ.0)THEN
          WRITE(ICOUT,4251)
 4251     FORMAT('METHOD OF MOMENTS AND RATIO OF FREQUENCIES:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4235)THETF2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4237)BETAF2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4239)AMF2
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,4261)
 4261   FORMAT('MAXIMUM LIKELIHOOD:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4235)THETML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4237)BETAML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4239)AMML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4291)
 4291   FORMAT('ESTIMATES ARE SAVED IN THE INTERNAL PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4292)
 4292   FORMAT('THETAMOM, BETAMOM, THETAFR, BETAFR, THETAML, ',
     1         'AND BETAML')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
C
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGNB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPMGNB--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPMGU1(Y,TAG,N,
     1XTEMP,DTEMP,MAXNXT,
     1SCALML,SCA2ML,SCALSE,SCALMO,SCMOSE,
     1UHATML,UHATSE,UHATMO,UMOMSE,COVSE,
     1NUMV,ICENTY,TEND,
     1ICAPSW,ICAPTY,IGUMBC,MINMAX,
     1QP,XQPHAT,XQPSE,XQPLCL,XQPUCL,NPERC,
     1XQPHTZ,XQPLCZ,XQPUCZ,
     1IOUNI1,IOUNI2,ALPHAP,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE MAXIMUM LIKELIHOOD
C              ESTIMATES FOR GUMBEL (EXTREME VALUE TYPE 1) DISTRIBUTION
C              FOR THE FULL SAMPLE CASE.
C     EXAMPLE--GUMBEL MAXIMUM LIKELIHOOD Y
C     REFERENCE--KARL BURY, "STATISTICAL DISTRIBUTIONS IN
C                ENGINEERING", CAMBRIDGE UNIVERSITY PRESS,
C                1999, CHAPTER 15.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/12
C     ORIGINAL VERSION--DECEMBER  2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICENTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGUMBC
      CHARACTER*1 IBASLC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*7 ICASE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      PARAMETER (NUMALP=6)
      DIMENSION ALPHA(NUMALP)
      DIMENSION ALOWU(NUMALP)
      DIMENSION AHIGHU(NUMALP)
      DIMENSION ALOWB(NUMALP)
      DIMENSION AHIGHB(NUMALP)
      DIMENSION A2LOWB(NUMALP)
      DIMENSION A2HGHB(NUMALP)
      DIMENSION A2LOWU(NUMALP)
      DIMENSION A2HGHU(NUMALP)
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION XTEMP(*)
      DIMENSION XQPHTZ(*)
      DIMENSION XQPLCZ(*)
      DIMENSION XQPUCZ(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPSE(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
C
      DOUBLE PRECISION DTEMP(*)
C
      DOUBLE PRECISION EV1FU2
      DOUBLE PRECISION EV1FU3
      DOUBLE PRECISION EV1FU4
      DOUBLE PRECISION EV1FU6
      EXTERNAL EV1FU2
      EXTERNAL EV1FU3
      EXTERNAL EV1FU4
      EXTERNAL EV1FU6
C
      INTEGER IN 
      DOUBLE PRECISION XBAR
      COMMON/EV1CO2/XBAR,MINMX2,IN
      DOUBLE PRECISION DK
      DOUBLE PRECISION DLLUS
      COMMON/EV1CO3/DK, DLLUS
      DOUBLE PRECISION SHAT
      COMMON/EV1CO4/SHAT
      DOUBLE PRECISION DQ
      DOUBLE PRECISION SHATML
      COMMON/EV1CO6/DQ,SHATML
C
      DOUBLE PRECISION DN
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DAE
      DOUBLE PRECISION DRE
      DOUBLE PRECISION DG
      DOUBLE PRECISION DS
      DOUBLE PRECISION DT1
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DXSTRT
      DOUBLE PRECISION DXLOW
      DOUBLE PRECISION DXUP
      DOUBLE PRECISION XLOWSV
      DOUBLE PRECISION XUPSV
C
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA ALPHA /0.50, 0.25, 0.10, 0.05, 0.01, 0.001/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPMG'
      ISUBN2='U1  '
C
      ICASE='Maximum'
      IF(MINMAX.NE.2)ICASE='Minimum'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPPGU1--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N,NUMV
   55   FORMAT('N,NUMV,NPERC = ',3I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),TAG(I)
   57     FORMAT('I,Y(I),TAG(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,59)ICENTY
   59   FORMAT('ICENTY = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 ',
     1         'IS <= 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N
 1113   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1132)HOLD
 1132 FORMAT('      VARIABLE 1 HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NPERC.GT.0)THEN
        DO1145I=1,NPERC
          IF(QP(I).LE.0.0 .OR. QP(I).GE.100.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1141)
 1141       FORMAT('***** WARNING IN GUMBEL MAXIMUM LIKELIHOOD--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1143)QP(I)
 1143       FORMAT('      REQUESTED PERCENTILE (',G15.7,') IS ',
     1             'OUTSIDE THE (0,100) INTERVAL')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1144)
 1144       FORMAT('      NO PERCENTILE CONFIDENCE LIMITS WILL BE ',
     1             'COMPUTED.')
            CALL DPWRST('XXX','WRIT')
            NPERC=0
          ENDIF
 1145   CONTINUE
      ENDIF
C
C
C               **********************************
C               **  STEP 41--                   **
C               **  CARRY OUT CALCULATIONS      **
C               **  FOR GUMBEL MLE              **
C               **  ESTIMATE (FULL SAMPLE CASE) **
C               **********************************
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
      IWRITE='OFF'
      AN=REAL(N)
C
      CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
      CALL MINIM(Y,N,IWRITE,XMIN,IBUGA3,IERROR)
      CALL MAXIM(Y,N,IWRITE,XMAX,IBUGA3,IERROR)
C
C  MOMENT ESTIMATES ARE:
C
C    MUHAT = XBAR - 0.45006*SD
C    SHAT  = 0.77970*SD
C
C  THE MAXIMUM LIKELIHOOD ESTIMATES ARE:
C
C
C  THE ML ESTIMATE OF THE SCALE PARAMETER IS THE SOLUTION TO
C  THE FOLLOWING EQUATION:
C
C              FOR THE MAXIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(-X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(-X(I)/SHAT)] = 0
C
C              FOR THE MINIMUM CASE:
C
C                 SHAT - XBAR + SUM[i=1 to N][X(I)*EXP(X(I)/SHAT)]/
C                        SUM[i=1 to N][EXP(X(I)/SHAT)] = 0
C
C              WITH
C
C                 SHAT     = CURRENT ESTIMATE OF SCALE PARAMETER
C                 XBAR     = SAMPLE MEAN
C                 N        = SAMPLE SIZE
C                 MINMAX   = SPECIFY WHETHER MAXIMUM OR MINIMUM
C                            CASE IS BEING ESTIMATED
C
C THE ML ESTIMATE OF LOCATION FOR THE MAXIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(-X(I)/SHAT)]/N)
C
C THE ML ESTIMATE OF LOCATION FOR THE MINIMUM CASE IS
C
C   MUHAT = -SHAT*LOG(SUM[i=1 to N][EXP(X(I)/SHAT)]/N)
C
C
      AN=REAL(N)
      DN=DBLE(N)
      IF(MINMAX.EQ.2)THEN
        UHATMO=XMEAN - 0.45006*XSD
      ELSE
        UHATMO=XMEAN + 0.45006*XSD
      ENDIF
      SCALMO=0.77970*XSD
      UMOMSE=SQRT(1.16781*SCALMO**2/AN)
      SCMOSE=1.10001*XSD**2/AN
C
      XBAR=DBLE(XMEAN)
      MINMX2=MINMAX
      IN=N
C
      DXSTRT=DBLE(SCALMO)
      DAE=2.0*0.000001D0*DXSTRT
      DRE=DAE
      IFLAG=0
      DXLOW=DXSTRT/2.0D0
      DXUP=2.0D0*DXSTRT
      ITBRAC=0
      DO3104I=1,N
        DTEMP(I)=DBLE(Y(I))
 3104 CONTINUE
C
 3105 CONTINUE
      XLOWSV=DXLOW
      XUPSV=DXUP
      CALL DFZER2(EV1FU2,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
C
      IF(IFLAG.EQ.4 .AND. ITBRAC.LE.100)THEN
        DXLOW=XLOWSV/2.0D0
        DXUP=2.0D0*XUPSV
        ITBRAC=ITBRAC+1
        GOTO3105
      ENDIF
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM GUMBEL MAXIMUM ',
CCCCC1         'LIKELIHOOD--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      ESTIMATE OF SIGMA MAY NOT BE COMPUTED TO ',
CCCCC1         'DESIRED TOLERANCE.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,121)
  121   FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      ESTIMATE OF SCALE MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,131)
  131   FORMAT('***** ERROR FROM GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,133)
  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,141)
  141   FORMAT('***** WARNING FROM GUMBEL MAXIMUM LIKELIHOOD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      SCALML=REAL(DXLOW)
      BN=(1.0 + 2.2/AN**1.13)
      SCA2ML=BN*SCALML
C
      DSUM1=0.0D0
      IF(MINMAX.EQ.2)THEN
        DO3108I=1,N
          DX=-DBLE(Y(I))
          DSUM1=DSUM1 + DEXP(DX/DBLE(SCALML))
 3108   CONTINUE
        DTERM1=-DBLE(SCALML)*DLOG(DSUM1/DN)
      ELSE
        DO3109I=1,N
          DX=DBLE(Y(I))
          DSUM1=DSUM1 + DEXP(DX/DBLE(SCALML))
 3109   CONTINUE
        DTERM1=DBLE(SCALML)*DLOG(DSUM1/DN)
      ENDIF
      UHATML=REAL(DTERM1)
C
      SCALSE=0.77970*SCALML/SQRT(AN)
      UHATSE=1.05293*SCALML/SQRT(AN)
      COVSE=0.50697*SCALML/SQRT(AN)
      IF(IGUMBC.EQ.'ON')THEN
        SCALSE=SCALSE*BN
        COVSE=COVSE*SQRT(BN)
      ENDIF
C
      IF(IGUMBC.EQ.'ON')THEN
        SCTEMP=SCA2ML
      ELSE
        SCTEMP=SCALML
      ENDIF
C
      DSUM1=0.0D0
      IF(MINMAX.EQ.2)THEN
        DO3110I=1,N
          DSUM1=DSUM1 + DEXP(-(Y(I) - DBLE(UHATML))/DBLE(SCALML))
 3110   CONTINUE
        DLLUS=-DN*DLOG(DBLE(SCALML)) - DN*XBAR/DBLE(SCALML) +
     1         DN*DBLE(UHATML)/DBLE(SCALML) - DSUM1
      ELSE
        DO3115I=1,N
          DSUM1=DSUM1 + DEXP((Y(I) + DBLE(UHATML))/DBLE(SCALML))
 3115   CONTINUE
        DLLUS=-DN*DLOG(DBLE(SCALML)) - DN*XBAR/DBLE(SCALML) +
     1         DN*DBLE(UHATML)/DBLE(SCALML) - DSUM1
      ENDIF
      SHAT=DBLE(SCALML)
C
      DAE=1.D-7
      DRE=1.D-7
      NUTEMP=1
C
      DO3120I=1,NUMALP
C
        ALP=ALPHA(I)
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,APPF)
        ALOWB(I)=SCTEMP - APPF*SCALSE
        AHIGHB(I)=SCTEMP + APPF*SCALSE
        ALOWU(I)=UHATML - APPF*UHATSE
        AHIGHU(I)=UHATML + APPF*UHATSE
C
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
C
        DXSTRT=DBLE(ALOWB(I))
        DXLOW=DXSTRT/5.0D0
        DXUP=DBLE(SCTEMP)
        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2LOWB(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AHIGHB(I))
        DXUP=DXSTRT*5.0D0
        DXLOW=DBLE(SCTEMP)
        CALL DFZER2(EV1FU3,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2HGHB(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(ALOWU(I))
        DXLOW=DXSTRT/2.0D0
        DXUP=DBLE(UHATML)
        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2LOWU(I)=REAL(DXLOW)
C
        DXSTRT=DBLE(AHIGHU(I))
        DXUP=DXSTRT*2.0D0
        DXLOW=DBLE(UHATML)
        CALL DFZER2(EV1FU4,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
        A2HGHU(I)=REAL(DXLOW)
C
 3120 CONTINUE
C
C               **********************************************
C               **  STEP 41B--                              **
C               **  ESTIMATE CONFIDENCE LIMITS FOR SELECTED **
C               **  PERCENTILES.  THE CONFIDENCE LIMITS ON  **
C               **  SIGMA ARE (SL,SU) ARE:                  **
C               **  (2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2),     **
C               **   2*N*SIGMAHAT/CHSPPF(2N,1-ALPHA/2))     **
C               **  THEN (XpLCL,XpUCL) IS:                  **
C               **  ((-LN(1 - Xp))*SL,(-LN(1 - Xp))*SU)     **
C               **********************************************
C
      ISTEPN='41B'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MLNO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  NOTE: COMMENTED OUT CODE IS 1-PARAMETER MODEL PLUS ESTIMATE
C        OF LOCATION.  FOR 2-PARAMETER MODEL, USE APPROXIMATION
C        FOR LOWER LIMIT GIVEN ON PP. 190-191 OF BURY.
C
      IF(NPERC.GE.1)THEN
C
        ALP=ALPHAP
        P=1.0-(ALP/2.0)
        CALL NORPPF(P,ANOR)
        CALL CHSPPF(1.0-ALP,NUTEMP,APPF)
        DK=DBLE(APPF)
        SHATML=DBLE(SCALML)
C
        DAE=1.D-7
        DRE=1.D-7
        NUTEMP=1
C
        WRITE(IOUNI2,3131)
 3131   FORMAT(15X,'       POINT     ','   STANDARD    ',
     1         '     LOWER     ','     UPPER')
        WRITE(IOUNI2,3132)
 3132   FORMAT('    PERCENTILE ','     ESTIMATE   ','     ERROR     ',
     1         'CONFIDENCE LIMIT ','CONFIDENCE LIMIT')
        DO3130I=1,NPERC
C
          QPTEMP=QP(I)/100.0
          CALL EV1PPF(QPTEMP,MINMAX,APPF)
C
          XQPHAT(I)=UHATML + SCTEMP*APPF
          SEXQP=UHATSE**2 + (APPF*SCALSE)**2 + 2.0*APPF*COVSE**2
          XQPSE(I)=SQRT(SEXQP)
          XQPLCL(I)=XQPHAT(I) - ANOR*XQPSE(I)
          XQPUCL(I)=XQPHAT(I) + ANOR*XQPSE(I)
          WRITE(IOUNI2,'(6E15.7)')
     1         QP(I),XQPHAT(I),SEXQP,XQPLCL(I),XQPUCL(I)
C
          DQ=DBLE(QPTEMP)
          DPPF=DBLE(XQPHAT(I))
          DXSTRT=DBLE(XQPLCL(I))
          DXLOW=DPPF/2.0D0
          DXUP=DBLE(XQPHAT(I))
          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
          XQPLCZ(I)=REAL(DXLOW)
C
          DXSTRT=DBLE(XQPUCL(I))
          DXUP=DPPF*2.0D0
          DXLOW=DBLE(XQPHAT(I))
          CALL DFZER2(EV1FU6,DXLOW,DXUP,DXSTRT,DRE,DAE,IFLAG,DTEMP)
          XQPUCZ(I)=REAL(DXLOW)
C
CCCCC     IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'MGU1')THEN
CCCCC       WRITE(ICOUT,3133)I,QP(I),XQPHAT(I),SEXQP,APPF
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3135)ACHSUL,ACHSLL,ATEMP1,ATEMP2
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC       WRITE(ICOUT,3137)XQPLCL(I),XQPUCL(I)
CCCCC       CALL DPWRST('XXX','BUG ')
CCCCC     ENDIF
 3130   CONTINUE
C
      ENDIF
C
C               *************************************
C               **   STEP 42--                     **
C               **   WRITE OUT EVERYTHING          **
C               **   FOR GUMBEL MLE ESTIMATE  **
C               *************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'MGU1')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
')
 5002   FORMAT('GUMBEL MAXIMUM LIKELIHOOD ESTIMATION:')
 5003   FORMAT('
Full Sample ',A7,' Extreme Values Case')
 5004   FORMAT('

f(x) = (1/s)e-(x-u)/se-e',
     1         '-(x-u)/s')
 5005   FORMAT('

f(x) = (1/s)e(x-u)/se-e',
     1         '(x-u)/s')
 5006   FORMAT('
u and s denote the location and scale ',
     1         'parameters, respectively')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)ICASE
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5004)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5005)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5006)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('
    ')
 5013   FORMAT('')
 5015   FORMAT('   ')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5016)
        CALL DPWRST('XXX','WRIT')
        IF(IGUMBC.EQ.'OFF')THEN
          WRITE(ICOUT,5017)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5018)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   ')
 5043   FORMAT('      ')
 5049   FORMAT('      ')
 5061   FORMAT('         Number of Observations:')
 5062   FORMAT('         Sample Minimum:')
 5063   FORMAT('         Sample Maximum:')
 5064   FORMAT('         Sample Mean:')
 5065   FORMAT('         Sample Standard Deviation:')
 5066   FORMAT('         Moment Estimate of Location:')
 5067   FORMAT('         Standard Error of Moment Estimate of ',
     1         'Location:')
 5068   FORMAT('         Moment Estimate of Scale:')
 5069   FORMAT('         Standard Error of Moment Estimate of Scale:')
 5070   FORMAT('         Maximum Likelihood Estimate of Location:')
 5071   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Location:')
 5072   FORMAT('         Maximum Likelihood Estimate of Scale:')
 5073   FORMAT('         Bias Corrected Maximum Likelihood Estimate ',
     1         'of Scale:')
 5074   FORMAT('         Standard Error of Maximum Likelihood ',
     1         'Estimate of Scale:')
 5075   FORMAT('         Standard Error of Covariance ')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMIN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5063)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMAX
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5064)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)XSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UMOMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5068)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALMO
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5069)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCMOSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5070)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)UHATSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCA2ML
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)SCALSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)COVSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('
    ')
 5016   FORMAT('      Standard Errors and Confidence Intervals')
 5017   FORMAT('      Based on No Bias Correction Scale ',
     1         'Parameter')
 5018   FORMAT('      Based on Bias Corrected Scale Parameter')
 5019   FORMAT('   
    ')
 5047   FORMAT('      ')
 5051   FORMAT('         ',G15.7)
 5053   FORMAT('         ',I8)
 5055   FORMAT('          ')
 5059   FORMAT('   
    ')
 5093   FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('
    ')
 5113   FORMAT('')
 5115   FORMAT('   ')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5129   FORMAT('      ')
 5161   FORMAT('      ')
 5147   FORMAT('      ')
 5149   FORMAT('      ')
        DO5150I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AHIGHB(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          IF(MINMAX.EQ.2)THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2LOWB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2HGHB(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5150   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('
    ')
 5117   FORMAT('      Confidence Limits for the Scale ',
     1         'Parameter')
 5119   FORMAT('   
    ')
 5125   FORMAT('         Confidence
    Value (%)')
 5127   FORMAT('          		')
 5131   FORMAT('         Lower
    Limit')
 5133   FORMAT('         Upper
    Limit')
 5134   FORMAT('          ')
 5136   FORMAT('          		')
 5137   FORMAT('         Normal Approximation')
 5138   FORMAT('         Likelihood Ratio')
 5139   FORMAT('   
    ')
55161   FORMAT('      ')
 5162   FORMAT('          
    ')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5136)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5138)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5161)
        ELSE
          WRITE(ICOUT,55161)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   
    ')
 5151   FORMAT('         ',G15.7)
 5159   FORMAT('   
    ')
 5193   FORMAT('
')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5217   FORMAT('      Confidence Limits for the Location ',
     1         'Parameter')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5217)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5136)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5137)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5136)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5138)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5131)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5129)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5133)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        IF(MINMAX.EQ.2)THEN
          WRITE(ICOUT,5161)
        ELSE
          WRITE(ICOUT,55161)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
        DO5140I=1,NUMALP
          ATEMP=100.0*(1.0 - ALPHA(I))
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ATEMP
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)ALOWU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)AHIGHU(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          IF(MINMAX.EQ.2)THEN
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2LOWU(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5149)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5151)A2HGHU(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,5147)
            CALL DPWRST('XXX','WRIT')
          ENDIF
          WRITE(ICOUT,5159)
          CALL DPWRST('XXX','WRIT')
 5140   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(NPERC.GT.0)THEN
 5801     FORMAT('
') 5811 FORMAT('