SUBROUTINE DPCIR2(X1,Y1,X2,Y2, 1IFIG, 1ILINPA,ILINCO,PLINTH, 1AREGBA, 1IREBLI,IREBCO,PREBTH, 1IREFSW,IREFCO, 1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP, 1PTEXHE,PTEXWI,PTEXVG,PTEXHG) C C PURPOSE--DRAW A CIRCLE C WITH ONE END OF THE DIAGONAL AT (X1,Y1) C AND THE OTHER END AT (X2,Y2). C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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 UPDATED --JANUARY 1989. MODIFY CALLS TO DPDRPL (ALAN) C UPDATED --JANUARY 1989. MODIFY CALL TO DPFIRE (ALAN) C UPDATED --FEBRAUARY 1993. USE EQUIVALENCE C C-----NON-COMMON VARIABLES------------------------------------- C CHARACTER*4 IFIG CHARACTER*4 IPATT2 C CHARACTER*4 ILINPA CHARACTER*4 ILINCO C CHARACTER*4 IREBLI CHARACTER*4 IREBCO CHARACTER*4 IREFSW CHARACTER*4 IREFCO CHARACTER*4 IREPTY CHARACTER*4 IREPLI CHARACTER*4 IREPCO C CHARACTER*4 IPATT CHARACTER*4 ICOLF CHARACTER*4 ICOLP CHARACTER*4 ICOL CHARACTER*4 IFLAG C DIMENSION PX(1000) DIMENSION PY(1000) CCCCC DIMENSION PX3(1000) CCCCC DIMENSION PY3(1000) CCCCC FOLLOWING LINES ADDED FEBRUARY 1994 INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOZZ.INC' EQUIVALENCE (GARBAG(1),PX(1)) EQUIVALENCE (GARBAG(1001),PY(1)) CCCCC END CHANGE C DIMENSION ILINPA(*) DIMENSION ILINCO(*) DIMENSION PLINTH(*) C DIMENSION AREGBA(*) DIMENSION IREBLI(*) DIMENSION IREBCO(*) DIMENSION PREBTH(*) DIMENSION IREFSW(*) DIMENSION IREFCO(*) DIMENSION IREPTY(*) DIMENSION IREPLI(*) DIMENSION IREPCO(*) DIMENSION PREPTH(*) DIMENSION PREPSP(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' 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 IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CIR2')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCIR2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)X1,Y1 53 FORMAT('X1,Y1 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)X2,Y2 54 FORMAT('X2,Y2 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IFIG 59 FORMAT('IFIG = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1) 61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)AREGBA(1) 62 FORMAT('AREGBA(1) = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1) 63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IREFSW(1),IREFCO(1) 64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) 65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ', 1A4,2X,A4,2X,A4,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)PTEXHE,PTEXWI 69 FORMAT('PTEXHE,PTEXWI= ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,70)PTEXVG,PTEXHG 70 FORMAT('PTEXVG,PTEXHG= ',2E15.6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4 79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ********************************* C ** STEP 1-- ** C ** DETERMINE THE COORDINATES ** C ** FOR THE CIRCLE ** C ********************************* C RATIHV=ANUMHP/ANUMVP C DELX=X2-X1 DELY=Y2-Y1 DELX=ABS(DELX) DELY=ABS(DELY) C ALEN=0.0 TERM=DELX**2+DELY**2 IF(TERM.GT.0.0)ALEN=SQRT(TERM) RADIUS=ALEN/2.0 C IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX) IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0 IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0 THETA=0.0 C XCENT=(X1+X2)/2.0 YCENT=(Y1+Y2)/2.0 X3=XCENT-RADIUS Y3=YCENT C K=0 C X=0.0 Y=0.0 Y=Y*RATIHV CALL TRANS(X,Y,X3,Y3,THETA,DELX,DELY,XP,YP,KXP,KYP) K=K+1 PX(K)=XP PY(K)=YP C DO3010I=181,541,5 IREV=541-I+181 PHI2=IREV-1 PHI2=PHI2*(2.0*3.1415926)/360.0 X=RADIUS*COS(PHI2)+RADIUS Y=RADIUS*SIN(PHI2) Y=Y*RATIHV CALL TRANS(X,Y,X3,Y3,THETA,DELX,DELY,XP,YP,KXP,KYP) K=K+1 PX(K)=XP PY(K)=YP 3010 CONTINUE C NP=K C C *********************** C ** STEP 2-- ** C ** FILL THE FIGURE ** C ** (IF CALLED FOR) ** C *********************** C IF(IREFSW(1).EQ.'OFF')GOTO2190 IPATT=IREPTY(1) IPATT2='SOLI' PTHICK=PREPTH(1) PXGAP=PREPSP(1) PYGAP=PREPSP(1) ICOLF=IREFCO(1) ICOLP=IREPCO(1) CALL DPFIRE(PX,PY,NP, 1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2) 2190 CONTINUE C C *************************** C ** STEP 3-- ** C ** DRAW OUT THE FIGURE ** C *************************** C IPATT=ILINPA(1) PTHICK=PLINTH(1) ICOL=ILINCO(1) IFLAG='ON' CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX,PY,NP, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CIR2')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCIR2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)DELX,DELY 9012 FORMAT('DELX,DELY = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)XCENT,YCENT,RADIUS,THETA 9013 FORMAT('XCENT,YCENT,RADIUS,THETA = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NP 9014 FORMAT('NP = ',I8) CALL DPWRST('XXX','BUG ') DO9015I=1,NP WRITE(ICOUT,9016)I,PX(I),PY(I) 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 9015 CONTINUE WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCIRC(IHARG,IARGT,ARG,NUMARG, 1PXSTAR,PYSTAR, 1PXEND,PYEND, 1ILINPA,ILINCO,PLINTH, 1AREGBA, 1IREBLI,IREBCO,PREBTH, 1IREFSW,IREFCO, 1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP, 1PTEXHE,PTEXWI,PTEXVG,PTEXHG, 1IGRASW,IDIASW, 1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2, 1PDIAHE,PDIAWI,PDIAVG,PDIAHG, 1NUMDEV, 1IDMANU,IDMODE,IDMOD2,IDMOD3, 1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT, 1IDNVOF,IDNHOF, CCCCC ADD FOLLOWING LINE MARCH 1997. 1IDFONT, CCCCC ADD FOLLOWING LINE JULY 1997. 1UNITSW, 1IBUGD2,IFOUND,IERROR) C C PURPOSE--DRAW ONE OR MORE CIRCLES C (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED). C THE COORDINATES ARE IN STANDARDIZED UNITS C OF 0 TO 100. C NOTE--THE INPUT COORDINATES DEFINE THE ENDS OF THE DIAMETER C OF THE CIRCLE. C NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2 C AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4. C NOTE--IF 2 NUMBERS ARE PROVIDED, C THEN THE DRAWN CIRCLE WILL GO C FROM THE LAST CURSOR POSITION C TO THE (X,Y) POINT C (EITHER ABSOLUTE OR RELATIVE) C AS DEFINED BY THE 2 NUMBERS. C NOTE--IF 4 NUMBERS ARE PROVIDED, C THEN THE DRAWN CIRCLE WILL GO C FROM THE ABSOLUTE (X,Y) POSITION C AS DEFINED BY THE FIRST 2 NUMBERS C TO THE (X,Y) POINT C (EITHER ABSOLUTE OR RELATIVE) C AS DEFINED BY THE THIRD AND FOURTH NUMBERS. C NOTE--IF 6 NUMBERS ARE PROVIDED, C THEN THE DRAWN CIRCLE WILL GO C FROM THE (X,Y) POSITION C AS RESULTING FROM THE THIRD AND FOURTH NUMBERS C TO THE (X,Y) POINT C (EITHER ABSOLUTE OR RELATIVE) C AS DEFINED BY THE FIFTH AND SIXTH NUMBERS. C NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS. C INPUT ARGUMENTS--IHARG C --IARGT C --ARG C --NUMARG C --PXSTAR C --PYSTAR C OUTPUT ARGUMENTS--PXEND C --PYEND C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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 --MARCH 1982. C UPDATED --MAY 1982. C UPDATED --NOVEMBER 1982. C UPDATED --JANUARY 1989. CALL LIST FOR OFFSET VAR (ALAN) C UPDATED --MARCH 1997. SUPPORT FOR DEVICE FONT (ALAN) C UPDATED --JULY 1997. SUPPORT FOR "DATA" UNITS (ALAN) C C-----NON-COMMON VARIABLES----------------------------------------- C CHARACTER*4 IHARG CHARACTER*4 IARGT C CHARACTER*4 ILINPA CHARACTER*4 ILINCO C CHARACTER*4 IREBLI CHARACTER*4 IREBCO CHARACTER*4 IREFSW CHARACTER*4 IREFCO CHARACTER*4 IREPTY CHARACTER*4 IREPLI CHARACTER*4 IREPCO C CHARACTER*4 IGRASW CHARACTER*4 IDIASW C CHARACTER*4 IDMANU CHARACTER*4 IDMODE CHARACTER*4 IDMOD2 CHARACTER*4 IDMOD3 CHARACTER*4 IDPOWE CHARACTER*4 IDCONT CHARACTER*4 IDCOLO CCCCC ADD FOLLOWING LINE MARCH 1997. CHARACTER*4 IDFONT CCCCC ADD FOLLOWING LINE JULY 1997. CHARACTER*4 UNITSW C CHARACTER*4 IFOUND CHARACTER*4 IBUGD2 CHARACTER*4 IERROR CHARACTER*4 ISUBRO C CHARACTER*4 IFIG CHARACTER*4 IBELSW CHARACTER*4 IERASW CHARACTER*4 IBACCO CHARACTER*4 ICOPSW CHARACTER*4 ITYPEO C DIMENSION IHARG(*) DIMENSION IARGT(*) DIMENSION ARG(*) C DIMENSION ILINPA(*) DIMENSION ILINCO(*) DIMENSION PLINTH(*) C DIMENSION AREGBA(*) DIMENSION IREBLI(*) DIMENSION IREBCO(*) DIMENSION PREBTH(*) DIMENSION IREFSW(*) DIMENSION IREFCO(*) DIMENSION IREPTY(*) DIMENSION IREPLI(*) DIMENSION IREPCO(*) DIMENSION PREPTH(*) DIMENSION PREPSP(*) C DIMENSION IDMANU(*) DIMENSION IDMODE(*) DIMENSION IDMOD2(*) DIMENSION IDMOD3(*) DIMENSION IDPOWE(*) DIMENSION IDCONT(*) DIMENSION IDCOLO(*) CCCCC ADD FOLLOWING LINE MARCH 1997. DIMENSION IDFONT(*) DIMENSION IDNVPP(*) DIMENSION IDNHPP(*) DIMENSION IDUNIT(*) C DIMENSION IDNVOF(*) DIMENSION IDNHOF(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' 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' IERRG4=IERROR CCCCC IBUGG4=IBUGD2 CCCCC ISUBG4=ISUBRO C ILOCFN=0 NUMNUM=0 C X1=0.0 Y1=0.0 X2=0.0 Y2=0.0 C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CIRC')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCIRC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)NUMARG 53 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 WRITE(ICOUT,57)PXSTAR,PYSTAR 57 FORMAT('PXSTAR,PYSTAR = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,58)PXEND,PYEND 58 FORMAT('PXEND,PYEND = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1) 61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)AREGBA(1) 62 FORMAT('AREGBA(1) = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1) 63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IREFSW(1),IREFCO(1) 64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) 65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ', 1A4,2X,A4,2X,A4,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)PTEXHE,PTEXWI 69 FORMAT('PTEXHE,PTEXWI= ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,70)PTEXVG,PTEXHG 70 FORMAT('PTEXVG,PTEXHG= ',2E15.6) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,76)IGRASW,IDIASW 76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC 77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG 78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,80)NUMDEV 80 FORMAT('NUMDEV= ',I8) CALL DPWRST('XXX','BUG ') DO81I=1,NUMDEV WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) 82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ', 1A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I) 83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ', 1A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I) 84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ', 1I8,I8,I8) CALL DPWRST('XXX','BUG ') 81 CONTINUE WRITE(ICOUT,87)IFOUND 87 FORMAT('IFOUND= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4 88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,89)IBUGD2,IERROR 89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C IFIG='CIRC' NUMPT=2 NUMPT2=2*NUMPT C C ******************************** C ** STEP 0-- ** C ** STEP THROUGH EACH DEVICE ** C ******************************** C IF(NUMDEV.LE.0)GOTO9000 DO8000IDEVIC=1,NUMDEV C IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000 C IMANUF=IDMANU(IDEVIC) IMODEL=IDMODE(IDEVIC) IMODE2=IDMOD2(IDEVIC) IMODE3=IDMOD3(IDEVIC) IGCONT=IDCONT(IDEVIC) IGCOLO=IDCOLO(IDEVIC) CCCCC ADD FOLLOWING LINE MARCH 1997. IGFONT=IDFONT(IDEVIC) NUMVPP=IDNVPP(IDEVIC) NUMHPP=IDNHPP(IDEVIC) ANUMVP=NUMVPP ANUMHP=NUMHPP C AUGUST 1988. ADD OFFSET VARIABLE IOFFSV=IDNVOF(IDEVIC) IOFFSH=IDNHOF(IDEVIC) C IGUNIT=IDUNIT(IDEVIC) C C ************************************ C ** STEP 1-- ** C ** CARRY OUT OPENING OPERATIONS ** C ** ON THE GRAPHICS DEVICES ** C ************************************ C CALL DPOPDE C IBELSW='OFF' NUMRIN=0 IERASW='OFF' IBACCO='JUNK' C CALL DPOPPL(IGRASW, 1IBELSW,NUMRIN,IERASW, 1IBACCO) C C ***************************************** C ** STEP 2-- ** C ** SEARCH FOR COMMAND SPECIFICATIONS ** C ***************************************** C IF(NUMARG.GE.2.AND. 1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB') 1GOTO1111 IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND. 1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB') 1GOTO1112 IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND. 1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB') 1GOTO1113 GOTO1130 C 1111 CONTINUE ITYPEO='ABSO' ILOCFN=1 GOTO1119 C 1112 CONTINUE ITYPEO='ABSO' ILOCFN=2 GOTO1119 C 1113 CONTINUE ITYPEO='RELA' ILOCFN=2 GOTO1119 1119 CONTINUE C IF(ILOCFN.GT.NUMARG)GOTO1129 DO1120I=ILOCFN,NUMARG IF(IARGT(I).EQ.'NUMB')GOTO1120 GOTO1129 1120 CONTINUE IFOUND='YES' GOTO1149 1129 CONTINUE GOTO1130 C 1130 CONTINUE IERRG4='YES' WRITE(ICOUT,1131) 1131 FORMAT('***** ERROR IN DPCIRC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1132) 1132 FORMAT(' ILLEGAL FORM FOR CIRCLE ', 1'COMMAND.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1134) 1134 FORMAT(' TEST EXAMPLE TO DEMONSTRATE THE ', 1'PROPER FORM--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1135) 1135 FORMAT(' SUPPOSE IT IS DESIRED TO DRAW A CIRCLE ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1136) 1136 FORMAT(' WITH ONE END OF A DIAGONAL AT 20 20 ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1137) 1137 FORMAT(' AND THE OTHER END OF THE DIAGONAL AT 40 60,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1141) 1141 FORMAT(' THEN ALLOWABLE FORMS ARE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1142) 1142 FORMAT(' CIRCLE 20 20 40 60') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1143) 1143 FORMAT(' CIRCLE ABSOLUTE 20 20 40 60') CALL DPWRST('XXX','BUG ') GOTO9000 1149 CONTINUE C C **************************** C ** STEP 3-- ** C ** DRAW OUT THE LINE(S) ** C **************************** C NUMNUM=NUMARG-ILOCFN+1 IF(NUMNUM.LT.NUMPT2)GOTO1151 GOTO1152 C 1151 CONTINUE J=ILOCFN-1 X1=PXSTAR Y1=PYSTAR GOTO1159 C 1152 CONTINUE J=ILOCFN IF(J.GT.NUMARG)GOTO1190 X1=ARG(J) CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997 IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR) J=J+1 IF(J.GT.NUMARG)GOTO1190 Y1=ARG(J) CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997 IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR) GOTO1159 C 1159 CONTINUE C 1160 CONTINUE J=J+1 IF(J.GT.NUMARG)GOTO1190 X2=ARG(J) CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997 IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR) IF(ITYPEO.EQ.'RELA')X2=X1+X2 J=J+1 IF(J.GT.NUMARG)GOTO1190 Y2=ARG(J) CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997 IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR) IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2 C CALL DPCIR2(X1,Y1,X2,Y2, 1IFIG, 1ILINPA,ILINCO,PLINTH, 1AREGBA, 1IREBLI,IREBCO,PREBTH, 1IREFSW,IREFCO, 1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP, 1PTEXHE,PTEXWI,PTEXVG,PTEXHG) C X1=X2 Y1=Y2 C GOTO1160 1190 CONTINUE C PXEND=X2 PYEND=Y2 C C ************************************ C ** STEP 4-- ** C ** CARRY OUT CLOSING OPERATIONS ** C ** ON THE GRAPHICS DEVICES ** C ************************************ C ICOPSW='OFF' NUMCOP=0 CALL DPCLPL(ICOPSW,NUMCOP, 1PGRAXF,PGRAYF, 1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2, 1PDIAHE,PDIAWI,PDIAVG,PDIAHG) C CALL DPCLDE C 8000 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CIRC')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCIRC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ILOCFN,NUMNUM 9012 FORMAT('ILOCFN,NUMNUM = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)X1,Y1,X2,Y2 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)PXSTAR,PYSTAR 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)PXEND,PYEND 9016 FORMAT('PXEND,PYEND = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)IFIG 9017 FORMAT('IFIG = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)IFOUND 9027 FORMAT('IFOUND = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)IBUGD2,IERROR 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLCH(PX,PY,NP,PX2,PY2,NP2,X3D2, 1PXMIN,PXMAX,PYMIN,PYMAX, 1ISORSW, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) C C PURPOSE--CARRY OUT CLIPPING (IF NECESSARY) C AND DRAW THE POLYMARKERS C (OR SERIES OF CLIPPED TRACES) C BASED ON THE DATA IN (PX,PY). C DANGER--THE INPUT VARIABLES PX(.) AND PY(.) MAY BE C CHANGED IN THIS SUBROUTINE (SEE STEP 0 BELOW) C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --DECEMBER 1999. SUPPORT FOR ROWID AND ROW LABEL C AS CHARACTERS. C UPDATED --JANUARY 2000. USE ISUB TO GET CORRECT VALUE C FOR ROWID AND ROW LABEL C UPDATED --JANUARY 2000. ADD X3D2 TO CALL LIST C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ISORSW C CHARACTER*4 IFIG CHARACTER*4 IPATT CHARACTER*4 IFONT CHARACTER*4 ICASE CHARACTER*4 IJUST CHARACTER*4 IDIR CHARACTER*4 IFILL CHARACTER*4 ICOL C CHARACTER*4 ISYMBL CHARACTER*4 ISPAC CHARACTER*4 IMPSW2 C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOZI.INC' DIMENSION IROWID(MAXOBV) DIMENSION IJUNK(MAXOBV) DIMENSION IJUNK2(MAXOBV) EQUIVALENCE (IGARBG(IIGAR1),IROWID(1)) EQUIVALENCE (IGARBG(IIGAR2),IJUNK(1)) EQUIVALENCE (IGARBG(IIGAR3),IJUNK2(1)) C DIMENSION PX(*) DIMENSION PY(*) C DIMENSION X3D2(*) C DIMENSION PX2(*) DIMENSION PY2(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOHK.INC' INCLUDE 'DPCODA.INC' 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 ISUBN1='DPCL' ISUBN2='CH ' C XMIN=CPUMAX YMIN=CPUMAX XMAX=CPUMIN YMAX=CPUMIN J=(-999) C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLCH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLCH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PXMIN,PXMAX,PYMIN,PYMAX 53 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4F10.5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISORSW 54 FORMAT('ISORSW = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)NP 61 FORMAT('NP = ',I8) CALL DPWRST('XXX','BUG ') DO62I=1,NP DEL1=PX(I)-PXMIN DEL2=PX(I)-PXMAX DEL3=PY(I)-PYMIN DEL4=PY(I)-PYMAX WRITE(ICOUT,63)I,PX(I),PY(I) 63 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)I,DEL1,DEL2,DEL3,DEL4 64 FORMAT('I,DEL1,DEL2,DEL3,DEL4 = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 62 CONTINUE WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4 69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ****************************************************** C ** STEP 0B-- * C ** SET VALUES OF IJUNK TO VALUES OF ISUB = 1. * C ** USED TO GET PROPER INDEX FOR ROWID * C ****************************************************** C DO81I=1,MAXOBV IJUNK(I)=0 IJUNK2(I)=0 IROWID(I)=I 81 CONTINUE J=0 DO83I=1,MAXOBV IF(ISUB(I).EQ.1)THEN J=J+1 IJUNK(J)=I IF(J.GE.NP)GOTO89 ENDIF 83 CONTINUE 89 CONTINUE C C **************************************************************** C ** STEP 0-- * C ** IF NECESSARY, * C ** ADJUST (= CHANGE) THE PX(.) AND PY(.) VALUES TO ALLOW FOR * C ** POSSIBLE ROUNDOFF NEAR THE LIMITS (PXMIN,PXMAX) * C ** AND (PYMIN,PYMAX) WHICH WOULD SHOW UP AS A DATA * C ** POINT NOT BEING PLOTTED WHEN IT SHOULD HAVE BEEN * C **************************************************************** C CALL DPSQUE(PX,PY,NP, 1PXMIN,PXMAX,PYMIN,PYMAX) C C ************************************************* C ** STEP 1-- ** C ** DETERMINE THE FIRST AND LAST ELEMENTS OF ** C ** THE (PX,PY) VECTORS WHICH MUST BE SCANNED ** C ** BASED ON WHETHER PX(.) IS SORTED ** C ** OR NOT. ** C ************************************************* C ISTEPN='1' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ISORSW.EQ.'ON')GOTO1100 GOTO1150 C 1100 CONTINUE DO1110I=1,NP I2=I IF(PX(I).GE.PXMIN)GOTO1115 1110 CONTINUE IMIN=NP+1 GOTO1119 1115 CONTINUE IMIN=I2 1119 CONTINUE C DO1120I=1,NP IREV=NP-I+1 IF(PX(IREV).LE.PXMAX)GOTO1125 1120 CONTINUE IMAX=0 GOTO1129 1125 CONTINUE IMAX=IREV 1129 CONTINUE GOTO1190 C 1150 CONTINUE IMIN=1 IMAX=NP GOTO1190 C 1190 CONTINUE IF(IMIN.GT.IMAX)GOTO9000 C C ******************************************************** C ** STEP 2-- ** C ** COMPUTE THE HORIZONTAL AXIS VARIABLE MIN AND MAX ** C ** FOR THE DATA WITHIN THE SUBSET ** C ******************************************************** C ISTEPN='2' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ISORSW.EQ.'ON')GOTO1210 GOTO1250 C 1210 CONTINUE XMIN=PX(IMIN) XMAX=PX(IMAX) GOTO1290 C 1250 CONTINUE XMIN=CPUMAX XMAX=CPUMIN DO1260I=IMIN,IMAX IF(PX(I).LT.XMIN)XMIN=PX(I) IF(PX(I).GT.XMAX)XMAX=PX(I) 1260 CONTINUE GOTO1290 C 1290 CONTINUE C C ****************************************************** C ** STEP 3-- ** C ** COMPUTE THE VERTICAL AXIS VARIABLE MIN AND MAX ** C ** FOR THE DATA WITHIN THE SUBSET ** C ****************************************************** C ISTEPN='3' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C YMIN=CPUMAX YMAX=CPUMIN DO1300I=IMIN,IMAX IF(PY(I).LT.YMIN)YMIN=PY(I) IF(PY(I).GT.YMAX)YMAX=PY(I) 1300 CONTINUE C C ******************************************************* C ** STEP 21-- ** C ** TREAT THE MOST COMMON AND MOST IMPORTANT CASE-- ** C ** ALL NP OBSERVATIONS ARE TO BE USED; ** C ** ALL X DATA ARE WITHIN THE FRAME; ** C ** ALL Y DATA ARE WITHIN THE FRAME. ** C ******************************************************* C IF(IMIN.EQ.1.AND.IMAX.EQ.NP.AND. 1XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX.AND. 1YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2100 GOTO2190 C 2100 CONTINUE ISTEPN='21' DO2101I=1,NP IROWID(I)=IJUNK(I) IJUNK2(I)=1 2101 CONTINUE IF(IBUGG4.EQ.'ON') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) CALL DPDRPM(PX,PY,NP,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) NP2=0 GOTO9000 C 2190 CONTINUE C C ******************************************************* C ** STEP 22-- ** C ** TREAT THE NEXT MOST COMMON AND MOST IMPORTANT CASE-- ** C ** A SUBSET OF THE NP OBSERVATIONS ARE TO BE USED; ** C ** ALL X DATA ARE WITHIN THE FRAME; ** C ** ALL Y DATA ARE WITHIN THE FRAME. ** C ******************************************************* C IF(XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX.AND. 1YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2200 GOTO2290 C 2200 CONTINUE ISTEPN='22' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2210I=IMIN,IMAX J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) IROWID(J)=IJUNK(I) IJUNK2(I)=1 2210 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) GOTO9000 C 2290 CONTINUE C C **************************************************** C ** STEP 23-- ** C ** TREAT THE CASE WHERE THE SUBSET IS SUCH THAT ** C ** ALL X'S ARE INSIDE THE FRAME, ** C ** BUT SOME Y'S ARE OUTSIDE THE FRAME. ** C **************************************************** C IF(XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX)GOTO2300 GOTO2390 C 2300 CONTINUE ISTEPN='23' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2310I=IMIN,IMAX IM1=I-1 IF(PY(I).GE.PYMIN.AND.PY(I).LE.PYMAX)GOTO2320 GOTO2330 C 2320 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) IROWID(J)=IJUNK(I) IJUNK2(I)=1 GOTO2310 C 2330 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) J=0 GOTO2310 C 2310 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) GOTO9000 C 2390 CONTINUE C C **************************************************** C ** STEP 24-- ** C ** TREAT THE CASE WHERE THE SUBSET IS SUCH THAT ** C ** ALL Y'S ARE INSIDE THE FRAME, ** C ** BUT SOME X'S ARE OUTSIDE THE FRAME ** C ** (AS IN THE CONSTRUCTION OF MAPS) ** C **************************************************** C IF(YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2400 GOTO2490 C 2400 CONTINUE ISTEPN='24' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2410I=IMIN,IMAX IM1=I-1 IF(PX(I).GE.PXMIN.AND.PX(I).LE.PXMAX)GOTO2420 GOTO2430 C 2420 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) IROWID(J)=IJUNK(I) IJUNK2(I)=1 GOTO2410 C 2430 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) 2435 CONTINUE J=0 GOTO2410 C 2410 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) GOTO9000 C 2490 CONTINUE C C **************************************************** C ** STEP 25-- ** C ** TREAT THE GENERAL CASE WHERE THE SUBSET IS SUCH THAT ** C ** SOME X'S MAY BE OUTSIDE THE FRAME, AND/OR ** C ** SOME Y'S MAY BE OUTSIDE THE FRAME ** C ** (AS IN THE CONSTRUCTION OF MAPS) ** C **************************************************** C 2500 CONTINUE ISTEPN='25' IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLCH') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2510I=IMIN,IMAX IM1=I-1 IF(PX(I).GE.PXMIN.AND.PX(I).LE.PXMAX.AND. 1 PY(I).GE.PYMIN.AND.PY(I).LE.PYMAX)GOTO2520 GOTO2530 C 2520 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) IROWID(J)=IJUNK(I) IJUNK2(I)=1 GOTO2510 C 2530 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) 2535 CONTINUE J=0 GOTO2510 C 2510 CONTINUE NP2=J IF(NP2.GE.1) 1CALL DPDRPM(PX2,PY2,NP2,X3D2,IJUNK2,IROWID,IROWLB, 1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1IMPSW2,AMPSCH,AMPSCW, 1ISYMBL,ISPAC) GOTO9000 C 2590 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLCH')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCLCH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PXMIN,PXMAX,PYMIN,PYMAX 9013 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4F10.5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISORSW 9014 FORMAT('ISORSW = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)IMIN,IMAX,J 9017 FORMAT('IMIN,IMAX,J = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)XMIN,XMAX,YMIN,YMAX 9018 FORMAT('XMIN,XMAX,YMIN,YMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)NP 9021 FORMAT('NP = ',I8) CALL DPWRST('XXX','BUG ') DO9022I=1,NP DEL1=PX(I)-PXMIN DEL2=PX(I)-PXMAX DEL3=PY(I)-PYMIN DEL4=PY(I)-PYMAX WRITE(ICOUT,9023)I,PX(I),PY(I) 9023 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)I,DEL1,DEL2,DEL3,DEL4 9024 FORMAT('I,DEL1,DEL2,DEL3,DEL4 = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 9022 CONTINUE WRITE(ICOUT,9031)NP2 9031 FORMAT('NP2 = ',I8) CALL DPWRST('XXX','BUG ') IF(NP2.GT.0)THEN DO9032I=1,NP2 WRITE(ICOUT,9033)I,PX2(I),PY2(I) 9033 FORMAT('I,PX2(I),YP2(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 9032 CONTINUE ENDIF WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLDE C C PURPOSE--CLOSE A GRAPHICS DEVICE C C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' 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 IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLDE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3 52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IGUNIT,IGCODE 53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3 54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)IGBAUD 55 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4 56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ****************************** C ** STEP 1-- ** C ** CLOSE GRAPHICS SOFTWARE ** C ****************************** C CCCCC CALL GRCLSO C C ***************************** C ** STEP 2-- ** C ** CLOSE GRAPHICS DEVICES ** C ***************************** C CALL GRCLDE C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCLDE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IGUNIT,IGCODE 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IGBAUD 9015 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IBUGG4,ISUBG4,IERRG4 9016 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLLO(IHARG,IARGT,ARG,NUMARG, 1CLLIMI,IFOUND,IERROR) C C PURPOSE--DEFINE THE LOWER BOUND OF THE LEFT-MOST CLASS C FOR HORIZONTAL VARIABLE OR VERTICAL VARIABLE OR BOTH C FOR DISTRIBUTIONAL PLOTS (E.G., HISTOGRAMS). C THE 2 LOWER LIMITS (ONE FOR THE X AXIS VARIABLE C AND ONE FOR THE Y AXIS VARIABLE) C ARE CONTAINED IN THE FIRST AND THIRD ELEMENTS OF THE C 4-ELEMENT VECTOR CLLIMI(.). C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --IARGT (A HOLLERITH VECTOR) C --ARG (A FLOATING POINT VECTOR) C --NUMARG C OUTPUT ARGUMENTS--CLLIMI (A 4-ELEMENT FLOATING POINT VECTOR C IN WHICH EACH ELEMENT IS AS FOLLOWS-- C 1) LOWER BOUND FOR HORIZONTAL VARIABLE C 2) UPPER BOUND FOR HORIZONTAL VARIABLE C (NOT AFFECTED) C 3) LOWER BOUND FOR VERTICAL VARIABLE C 4) UPPER BOUND FOR VERTICAL VARIABLE C (NOT AFFECTED) C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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 --MAY 1981. C UPDATED --MAY 1982. 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 DIMENSION CLLIMI(4) 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 C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE HORIZONTAL VARIABLE LOWER BOUND IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XLOW')GOTO1100 GOTO1199 C 1100 CONTINUE IF(NUMARG.EQ.1)GOTO1110 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1120 GOTO1110 C 1110 CONTINUE IFOUND='YES' CLLIMI(1)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1119 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT('THE HORIZONTAL AXIS VARIABLE LOWER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT('SO THAT IT WILL BE XBAR - 6*XSD') CALL DPWRST('XXX','BUG ') 1119 CONTINUE GOTO1900 C 1120 CONTINUE IFOUND='YES' CLLIMI(1)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1125) 1125 FORMAT('THE HORIZONTAL AXIS VARIABLE LOWER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1126) 1126 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1127)CLLIMI(1) 1127 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1129 CONTINUE GOTO1900 C 1199 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE VERTICAL VARIABLE LOWER BOUND IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YLOW')GOTO1200 GOTO1299 C 1200 CONTINUE IF(NUMARG.EQ.1)GOTO1210 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1220 GOTO1210 C 1210 CONTINUE IFOUND='YES' CLLIMI(3)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1219 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT('THE VERTICAL AXIS VARIABLE LOWER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217) 1217 FORMAT('SO THAT IT WILL BE YBAR - 6*YSD') CALL DPWRST('XXX','BUG ') 1219 CONTINUE GOTO1900 C 1220 CONTINUE IFOUND='YES' CLLIMI(3)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1229 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1225) 1225 FORMAT('THE VERTICAL AXIS VARIABLE LOWER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1226) 1226 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1227)CLLIMI(3) 1227 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1229 CONTINUE GOTO1900 C 1299 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE LOWER BOUNDS FOR BOTH VARIABLES ARE TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XYLO')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YXLO')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LOWE')GOTO1300 GOTO1399 C 1300 CONTINUE IF(NUMARG.EQ.1)GOTO1310 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1320 GOTO1310 C 1310 CONTINUE IFOUND='YES' CLLIMI(1)=CPUMIN CLLIMI(3)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1319 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1315) 1315 FORMAT('THE LOWER BOUNDS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1316) 1316 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1317) 1317 FORMAT('SO THAT THEY WILL BE AVERAGE - 6*SD') CALL DPWRST('XXX','BUG ') 1319 CONTINUE GOTO1900 C 1320 CONTINUE IFOUND='YES' CLLIMI(1)=ARG(NUMARG) CLLIMI(3)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1329 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1325) 1325 FORMAT('THE LOWER BOUNDS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1326) 1326 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1327)CLLIMI(1) 1327 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1329 CONTINUE GOTO1900 C 1399 CONTINUE C 1900 CONTINUE RETURN END SUBROUTINE DPCLPL(ICOPSW,NUMCOP, 1PGRAXF,PGRAYF, 1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2, 1PDIAHE,PDIAWI,PDIAVG,PDIAHG) C C PURPOSE--CARRY OUT CLOSING OPERATIONS C SUBSEQUENT TO THE GENERATION OF A PLOT. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CHARACTER*4 IFONT C CHARACTER*4 IGRASW CHARACTER*4 ICOPSW C CHARACTER*4 ICASE C C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' 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 IFONT=IMANUF C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLPL')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3 52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IGUNIT,IGCODE 53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3 54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)IGBAUD 55 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IFONT 56 FORMAT('IFONT = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)ICOPSW 61 FORMAT('ICOPSW= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)NUMCOP 62 FORMAT('NUMCOP= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)PGRAXF,PGRAYF 63 FORMAT('PGRAXF,PGRAYF = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IGRASW 64 FORMAT('IGRASW= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)PDIAXC,PDIAYC,PDIAX2,PDIAY2 65 FORMAT('PDIAXC,PDIAYC,PDIAX2,PDIAY2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,66)PDIAHE,PDIAWI 66 FORMAT('PDIAHE,PDIAWI = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)PDIAVG,PDIAHG 67 FORMAT('PDIAVG,PDIAHG = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4 69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************ C ** STEP 1-- ** C ** COPY THE SCREEN, ** C ** IF CALLED FOR ** C ************************ C IF(ICOPSW.EQ.'OFF')GOTO1190 IF(NUMCOP.LE.0)GOTO1190 DO1100I=1,NUMCOP CALL GRCOSC 1100 CONTINUE 1190 CONTINUE C C ************************************************* C ** STEP 2-- ** C ** MOVE THE BEAM TO THE BOTTOM LEFT VICINITY ** C ** OF THE GRAPHICS REGION. ** C ************************************************* C CALL GRMOBE(PGRAXF,PGRAYF) C C ********************************************** C ** STEP 4-- ** C ** TRANSLATE THE CHARACTER REPRESENTATION ** C ** OF THE DIALOGUE MODE BEAM SIZE ** C ** INTO A NUMERIC REPRESENTATION ** C ** WHICH CAN BE UNDERSTOOD BY THE ** C ** GRAPHICS DEVICE. ** C ********************************************** C ICASE='MARK' C PHEIGH=PDIAHE PWIDTH=PDIAWI PVEGAP=PDIAVG PHOGAP=PDIAHG CALL GRTRSI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2) C C ************************************ C ** STEP 5-- ** C ** SET THE DIALOGUE MODE SIZE ** C ** ON THE GRAPHICS DEVICE. ** C ************************************ C CALL GRSESI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2) C C ************************************************* C ** STEP 6-- ** C ** MOVE THE BEAM TO THE PROPER POINT ** C ** (USUALLY IN THE LOWER LEFT) ** C ** ON THE SCREEN. ** C ************************************************* C CALL GRMOBE(PDIAX2,PDIAY2) PSUM=PDIAHE+PDIAVG PDIAY2=PDIAY2-PSUM IF(PDIAY2.LE.PSUM)PDIAY2=PDIAYC IF(PDIAY2.GE.100.0)PDIAY2=PDIAYC C C *********************************************************** C ** STEP 11-- ** C ** EXIT OUT OF GRAPHICS MODE AND ** C ** AND MOVE TO DIALOGUE (= MONITOR) MODE. ** C ** THE DIALOGUE MODE ON VARIOUS TERMINALS ** C ** IS USUALLY OF 3 TYPES-- ** C ** 1. FOR TERMINALS WITH NO FORMAL DIALOGUE REGION AND ** C ** NO BACKGROUND DIALOGUE PLANE ** C ** (AND THUS SUCCEDING NON-GRAPHICS TEXT WILL ** C ** OVERWRITE THE GRAPHICS ON THE SCREEN), ** C ** THEN DO NOTHING. ** C ** 2. FOR THOSE TERMINALS IN WHICH THE SCREEN ** C ** IS SHARED BETWEEN A GRAPHICS REGION AND ** C ** A MONITOR REGION (USUALLY AT THE BOTTOM), ** C ** THEN GO TO THE MONITOR REGION. ** C ** 3. FOR TERMINALS WITH A FULL-SCREEN BACKGROUND ** C ** DIALOGUE PLANE THAT THE USER CAN FLIP-FLOP TO ** C ** AND WHICH IS INDEPENDENT OF THE GRAPHICS PLANE, ** C ** THEN GO TO THE DIALOGUE PLANE. ** C *********************************************************** C C THE FOLLOWING WAS A SIGGRAPH PATCH FOR THE 4129 (DALLAS) AUG. 19, 1986 CCCCC IGRASW='OFF' IGRASW='OFF' CALL GRSEMO(IGRASW,PDIAXC,PDIAYC) C C ********************* C ** STEP 6-- ** C ** REVIVE PROMPT ** C ********************* C CCCCC CALL GRREPR C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLPL')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCLPL--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IGUNIT,IGCODE 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IGBAUD 9015 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)ICOPSW 9021 FORMAT('ICOPSW= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)NUMCOP 9022 FORMAT('NUMCOP= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)PGRAXF,PGRAYF 9023 FORMAT('PGRAXF,PGRAYF = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)IGRASW 9024 FORMAT('IGRASW= ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)PDIAXC,PDIAYC,PDIAX2,PDIAY2 9025 FORMAT('PDIAXC,PDIAYC,PDIAX2,PDIAY2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9026)PDIAHE,PDIAWI 9026 FORMAT('PDIAHE,PDIAWI = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)PDIAVG,PDIAHG 9027 FORMAT('PDIAVG,PDIAHG = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) C C PURPOSE--GIVEN THE 2 POINTS (PXOLD,PYOLD) AND (PXNEW,PYNEW) C (ONE OF WHICH IS DEFINITELY IN THE FRAME C DEFINED BY (PXMIN,PYMIN) AND (PXMAX,PYMAX) C AND THE OTHER OF WHICH IS OUTSIDE THAT FRAME, C COMPUTE THE POINT (PXNEW,PYNEW) WHICH C IS THAT VALUE ON THE FRAME IN WHICH THE LINE SEGMENT C INTERSECTS THE FRAME. C THIS ALLOWS THE SUBROUTINE DPCLIP C TO CARRY OUT CLIPPING. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN 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 ISUBN1='DPCL' ISUBN2='P2 ' C PX1=PXOLD PY1=PYOLD PX2=PXCUR PY2=PYCUR PX3=PXCUR PY3=PYCUR C SLOPE=0.0 AINT=0.0 C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLT2')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLT2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)PXOLD,PYOLD 52 FORMAT('PXOLD,PYOLD = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PXCUR,PYCUR 53 FORMAT('PXCUR,PYCUR = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)PXMIN,PYMIN,PXMAX,PYMAX 54 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4 59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************************************ C ** STEP 1-- ** C ** EITHER (PXOLD,PYOLD) OR (PXCUR,PYCUR) ** C ** MUST BE WITHIN THE FRAME. ** C ** DETERMINE WHICH ONE IS. ** C ** (PX1,PY1) WILL REFER TO THE POINT INSIDE THE FRAME. ** C ** (PX2,PY2) WILL REFER TO THE POINT OUTSIDE THE FRAME. ** C ************************************************************ C ISTEPN='1' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(PXOLD.GE.PXMIN.AND.PXOLD.LE.PXMAX.AND. 1 PYOLD.GE.PYMIN.AND.PYOLD.LE.PYMAX)GOTO1110 IF(PXCUR.GE.PXMIN.AND.PXCUR.LE.PXMAX.AND. 1 PYCUR.GE.PYMIN.AND.PYCUR.LE.PYMAX)GOTO1120 GOTO1130 C 1110 CONTINUE PX1=PXOLD PY1=PYOLD PX2=PXCUR PY2=PYCUR GOTO1190 C 1120 CONTINUE PX1=PXCUR PY1=PYCUR PX2=PXOLD PY2=PYOLD GOTO1190 C 1130 CONTINUE IERRG4='YES' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1131) 1131 FORMAT('***** INTERNAL ERROR IN DPCLT2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1132) 1132 FORMAT(' UPON INPUT TO THIS SUBROUTINE,') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1133) 1133 FORMAT(' AT LEAST ONE POINT MUST BE') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1134) 1134 FORMAT(' WITHIN THE FRAME--BUT WAS NOT.') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1135)PXMIN,PXMAX,PYMIN,PYMAX 1135 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1136)PXOLD,PYOLD,PXCUR,PYCUR 1136 FORMAT('PXOLD,PYOLD,PXCUR,PYCUR = ',4E15.7) CALL DPWRST('XXX','BUG ') GOTO9000 C 1190 CONTINUE C C ********************************** C ** STEP 2-- ** C ** DETERMINE THE FRAME POINT. ** C ** THIS WILL BE (PX3,PY3). ** C ********************************** C ISTEPN='2' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(PX1.EQ.PX2)GOTO1200 GOTO1250 C C ************************************** C ** STEP 2.1-- ** C ** TREAT THE SUBCASE WHEN PX1 = PX2** C ************************************** C 1200 CONTINUE ISTEPN='2.1' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C PX3=PX2 C PY3=PY2 IF(PY2.LT.PYMIN)PY3=PYMIN IF(PY2.GT.PYMAX)PY3=PYMAX C GOTO1290 C C *************************************************** C ** STEP 2.2-- ** C ** TREAT THE SUBCASE WHEN PX1 DOES NOT EQUAL PX2** C *************************************************** C 1250 CONTINUE ISTEPN='2.2' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C SLOPE=(PY2-PY1)/(PX2-PX1) AINT=PY2-SLOPE*PX2 C PX3=PX2 IF(PX2.LT.PXMIN)PX3=PXMIN IF(PX2.GT.PXMAX)PX3=PXMAX C PY3=SLOPE*PX3+AINT IF(PY3.LT.PYMIN)GOTO1260 IF(PY3.GT.PYMAX)GOTO1270 GOTO1290 C 1260 CONTINUE PY3=PYMIN PX3=0.0 IF(SLOPE.NE.0.0)PX3=(PY3-AINT)/SLOPE GOTO1290 C 1270 CONTINUE PY3=PYMAX PX3=0.0 IF(SLOPE.NE.0.0)PX3=(PY3-AINT)/SLOPE GOTO1290 C 1290 CONTINUE PXNEW=PX3 PYNEW=PY3 GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLT2')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCLT2--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)PXOLD,PYOLD 9012 FORMAT('PXOLD,PYOLD = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PXCUR,PYCUR 9013 FORMAT('PXCUR,PYCUR = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)PXMIN,PYMIN,PXMAX,PYMAX 9014 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)PX1,PY1 9021 FORMAT('PX1,PY1 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)PX2,PY2 9022 FORMAT('PX2,PY2 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)PX3,PY3 9023 FORMAT('PX3,PY3 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9025)SLOPE,AINT 9025 FORMAT('SLOPE,AINT = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9026)PXNEW,PYNEW 9026 FORMAT('PXNEW,PYNEW = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLTR(PX,PY,NP,PX2,PY2,NP2,PY3,PX3,NP3, 1PXMIN,PXMAX,PYMIN,PYMAX, 1ISORSW, 1IFIG,IPATT,PTHICK,ICOL) C C PURPOSE--CARRY OUT CLIPPING (IF NECESSARY) C AND DRAW A TRACE C (OR SERIES OF CLIPPED TRACES) C BASED ON THE DATA IN (PX,PY). C DANGER--THE INPUT VARIABLES PX(.) AND PY(.) MAY BE C CHANGED IN THIS SUBROUTINE (SEE STEP 0 BELOW) C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. MODIFY CALLS TO DPDRPL (ALAN) C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 ISORSW C CHARACTER*4 IFIG CHARACTER*4 IPATT CHARACTER*4 ICOL CHARACTER*4 IFLAG C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C--------------------------------------------------------------------- C DIMENSION PX(*) DIMENSION PY(*) C DIMENSION PX2(*) DIMENSION PY2(*) C CCCCC DIMENSION PX3(*) CCCCC DIMENSION PY3(*) 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 ISUBN1='DPCL' ISUBN2='PL ' C XMIN=CPUMAX YMIN=CPUMAX XMAX=CPUMIN YMAX=CPUMIN J=(-999) C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLTR')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF DPCLTR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PXMIN,PXMAX,PYMIN,PYMAX 53 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISORSW 54 FORMAT('ISORSW = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IFIG,IPATT,PTHICK,ICOL 56 FORMAT('IFIG,IPATT,PTHICK,ICOL = ',A4,2X,A4,E15.7,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)NP 61 FORMAT('NP = ',I8) CALL DPWRST('XXX','BUG ') DO62I=1,NP DEL1=PX(I)-PXMIN DEL2=PX(I)-PXMAX DEL3=PY(I)-PYMIN DEL4=PY(I)-PYMAX WRITE(ICOUT,63)I,PX(I),PY(I) 63 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)I,DEL1,DEL2,DEL3,DEL4 64 FORMAT('I,DEL1,DEL2,DEL3,DEL4 = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 62 CONTINUE WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4 69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************************************** C ** STEP 0-- * C ** IF NECESSARY, * C ** ADJUST (= CHANGE) THE PX(.) AND PY(.) VALUES TO ALLOW FOR * C ** POSSIBLE ROUNDOFF NEAR THE LIMITS (PXMIN,PXMAX) * C ** AND (PYMIN,PYMAX) WHICH WOULD SHOW UP AS A DATA * C ** POINT NOT BEING PLOTTED WHEN IT SHOULD HAVE BEEN * C **************************************************************** C CALL DPSQUE(PX,PY,NP, 1PXMIN,PXMAX,PYMIN,PYMAX) C C ************************************************* C ** STEP 1-- ** C ** DETERMINE THE FIRST AND LAST ELEMENTS OF ** C ** THE (PX,PY) VECTORS WHICH MUST BE SCANNED ** C ** BASED ON WHETHER PX(.) IS SORTED ** C ** OR NOT. ** C ************************************************* C ISTEPN='1' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ISORSW.EQ.'ON')GOTO1100 GOTO1150 C 1100 CONTINUE DO1110I=1,NP I2=I IF(PX(I).GE.PXMIN)GOTO1115 1110 CONTINUE IMIN=NP+1 GOTO1119 1115 CONTINUE IMIN=I2 1119 CONTINUE C DO1120I=1,NP IREV=NP-I+1 IF(PX(IREV).LE.PXMAX)GOTO1125 1120 CONTINUE IMAX=0 GOTO1129 1125 CONTINUE IMAX=IREV 1129 CONTINUE GOTO1190 C 1150 CONTINUE IMIN=1 IMAX=NP GOTO1190 C 1190 CONTINUE IF(IMIN.GT.IMAX)GOTO9000 C C ******************************************************** C ** STEP 2-- ** C ** COMPUTE THE HORIZONTAL AXIS VARIABLE MIN AND MAX ** C ** FOR THE DATA WITHIN THE SUBSET ** C ******************************************************** C ISTEPN='2' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(ISORSW.EQ.'ON')GOTO1210 GOTO1250 C 1210 CONTINUE XMIN=PX(IMIN) XMAX=PX(IMAX) GOTO1290 C 1250 CONTINUE XMIN=CPUMAX XMAX=CPUMIN DO1260I=IMIN,IMAX IF(PX(I).LT.XMIN)XMIN=PX(I) IF(PX(I).GT.XMAX)XMAX=PX(I) 1260 CONTINUE GOTO1290 C 1290 CONTINUE C C ****************************************************** C ** STEP 3-- ** C ** COMPUTE THE VERTICAL AXIS VARIABLE MIN AND MAX ** C ** FOR THE DATA WITHIN THE SUBSET ** C ****************************************************** C ISTEPN='3' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C YMIN=CPUMAX YMAX=CPUMIN DO1300I=IMIN,IMAX IF(PY(I).LT.YMIN)YMIN=PY(I) IF(PY(I).GT.YMAX)YMAX=PY(I) 1300 CONTINUE C C ******************************************************* C ** STEP 21-- ** C ** TREAT THE MOST COMMON AND MOST IMPORTANT CASE-- ** C ** ALL NP OBSERVATIONS ARE TO BE USED; ** C ** ALL X DATA ARE WITHIN THE FRAME; ** C ** ALL Y DATA ARE WITHIN THE FRAME. ** C ******************************************************* C IF(IMIN.EQ.1.AND.IMAX.EQ.NP.AND. 1XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX.AND. 1YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2100 GOTO2190 C 2100 CONTINUE ISTEPN='21' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) IFLAG='ON' CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX,PY,NP, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) GOTO9000 C 2190 CONTINUE C C ******************************************************* C ** STEP 22-- ** C ** TREAT THE NEXT MOST COMMON AND MOST IMPORTANT CASE-- ** C ** A SUBSET OF THE NP OBSERVATIONS ARE TO BE USED; ** C ** ALL X DATA ARE WITHIN THE FRAME; ** C ** ALL Y DATA ARE WITHIN THE FRAME. ** C ******************************************************* C IF(XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX.AND. 1YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2200 GOTO2290 C 2200 CONTINUE ISTEPN='22' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2210I=IMIN,IMAX J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) 2210 CONTINUE NP2=J IFLAG='ON' CCCCC CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) GOTO9000 C 2290 CONTINUE C C **************************************************** C ** STEP 23-- ** C ** TREAT THE CASE WHERE THE SUBSET IS SUCH THAT ** C ** ALL X'S ARE INSIDE THE FRAME, ** C ** BUT SOME Y'S ARE OUTSIDE THE FRAME. ** C **************************************************** C IF(XMIN.GE.PXMIN.AND.XMAX.LE.PXMAX)GOTO2300 GOTO2390 C 2300 CONTINUE ISTEPN='23' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2310I=IMIN,IMAX IM1=I-1 IF(PY(I).GE.PYMIN.AND.PY(I).LE.PYMAX)GOTO2320 GOTO2330 C 2320 CONTINUE IF(IM1.LT.IMIN)GOTO2325 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PYOLD.GE.PYMIN.AND.PYOLD.LE.PYMAX)GOTO2325 CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW C 2325 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) GOTO2310 C 2330 CONTINUE IF(IM1.LT.IMIN)GOTO2335 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PYOLD.GE.PYMIN.AND.PYOLD.LE.PYMAX)GOTO2333 GOTO2335 C 2333 CONTINUE CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW NP2=J IFLAG='ON' CCCCC CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) C 2335 CONTINUE J=0 GOTO2310 C 2310 CONTINUE NP2=J IFLAG='ON' IF(NP2.GE.1) CCCCC1CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) 1CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) GOTO9000 C 2390 CONTINUE C C **************************************************** C ** STEP 24-- ** C ** TREAT THE CASE WHERE THE SUBSET IS SUCH THAT ** C ** ALL Y'S ARE INSIDE THE FRAME, ** C ** BUT SOME X'S ARE OUTSIDE THE FRAME ** C ** (AS IN THE CONSTRUCTION OF MAPS) ** C **************************************************** C IF(YMIN.GE.PYMIN.AND.YMAX.LE.PYMAX)GOTO2400 GOTO2490 C 2400 CONTINUE ISTEPN='24' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2410I=IMIN,IMAX IM1=I-1 IF(PX(I).GE.PXMIN.AND.PX(I).LE.PXMAX)GOTO2420 GOTO2430 C 2420 CONTINUE IF(IM1.LT.IMIN)GOTO2425 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PXOLD.GE.PXMIN.AND.PXOLD.LE.PXMAX)GOTO2425 CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW 2425 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) GOTO2410 C 2430 CONTINUE IF(IM1.LT.IMIN)GOTO2435 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PXOLD.GE.PXMIN.AND.PXOLD.LE.PXMAX)GOTO2433 GOTO2435 2433 CONTINUE CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW NP2=J IFLAG='ON' CCCCC CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) 2435 CONTINUE J=0 GOTO2410 C 2410 CONTINUE NP2=J IFLAG='ON' IF(NP2.GE.1) CCCCC1CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) 1CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) GOTO9000 C 2490 CONTINUE C C **************************************************** C ** STEP 25-- ** C ** TREAT THE GENERAL CASE WHERE THE SUBSET IS SUCH THAT ** C ** SOME X'S MAY BE OUTSIDE THE FRAME, AND/OR ** C ** SOME Y'S MAY BE OUTSIDE THE FRAME ** C ** (AS IN THE CONSTRUCTION OF MAPS) ** C **************************************************** C 2500 CONTINUE ISTEPN='25' IF(IBUGG4.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) J=0 DO2510I=IMIN,IMAX IM1=I-1 IF(PX(I).GE.PXMIN.AND.PX(I).LE.PXMAX.AND. 1 PY(I).GE.PYMIN.AND.PY(I).LE.PYMAX)GOTO2520 GOTO2530 C 2520 CONTINUE IF(IM1.LT.IMIN)GOTO2525 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PXOLD.GE.PXMIN.AND.PXOLD.LE.PXMAX.AND. 1 PYOLD.GE.PYMIN.AND.PYOLD.LE.PYMAX)GOTO2525 CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW 2525 CONTINUE J=J+1 PX2(J)=PX(I) PY2(J)=PY(I) GOTO2510 C 2530 CONTINUE IF(IM1.LT.IMIN)GOTO2535 PXOLD=PX(IM1) PYOLD=PY(IM1) PXCUR=PX(I) PYCUR=PY(I) IF(PXOLD.GE.PXMIN.AND.PXOLD.LE.PXMAX.AND. 1 PYOLD.GE.PYMIN.AND.PYOLD.LE.PYMAX)GOTO2533 GOTO2535 2533 CONTINUE CALL DPCLT2(PXOLD,PYOLD,PXCUR,PYCUR, 1PXMIN,PXMAX,PYMIN,PYMAX, 1PXNEW,PYNEW) J=J+1 PX2(J)=PXNEW PY2(J)=PYNEW NP2=J IFLAG='ON' CCCCC CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) 2535 CONTINUE J=0 GOTO2510 C 2510 CONTINUE NP2=J IFLAG='ON' IF(NP2.GE.1) CCCCC1CALL DPDRPL(PX2,PY2,NP2,PX3,PY3,NP3, CCCCC1IFIG,IPATT,PTHICK,ICOL) 1CALL DPDRPL(PX2,PY2,NP2, 1IFIG,IPATT,PTHICK,ICOL, 1JPATT,JTHICK,PTHIC2,JCOL,IFLAG) GOTO9000 C 2590 CONTINUE C C ***************** C ** STEP 90-- ** C ** EXIT. ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLTR')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF DPCLTR--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PXMIN,PXMAX,PYMIN,PYMAX 9013 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISORSW 9014 FORMAT('ISORSW = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)IFIG,IPATT,PTHICK,ICOL 9016 FORMAT('IFIG,IPATT,PTHICK,ICOL = ',A4,2X,A4,E15.7,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)IMIN,IMAX,J 9017 FORMAT('IMIN,IMAX,J = ',3I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)XMIN,XMAX,YMIN,YMAX 9018 FORMAT('XMIN,XMAX,YMIN,YMAX = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)NP 9021 FORMAT('NP = ',I8) CALL DPWRST('XXX','BUG ') DO9022I=1,NP DEL1=PX(I)-PXMIN DEL2=PX(I)-PXMAX DEL3=PY(I)-PYMIN DEL4=PY(I)-PYMAX WRITE(ICOUT,9023)I,PX(I),PY(I) 9023 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)I,DEL1,DEL2,DEL3,DEL4 9024 FORMAT('I,DEL1,DEL2,DEL3,DEL4 = ',I8,4E15.7) CALL DPWRST('XXX','BUG ') 9022 CONTINUE WRITE(ICOUT,9031)NP2 9031 FORMAT('NP2 = ',I8) CALL DPWRST('XXX','BUG ') CCCCC DO9032I=1,NP2 DO9032I=1,NP WRITE(ICOUT,9033)I,PX2(I),PY2(I) 9033 FORMAT('I,PX2(I),YP2(I) = ',I8,2E15.7) CALL DPWRST('XXX','BUG ') 9032 CONTINUE WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE DPCLUP(IHARG,IARGT,ARG,NUMARG, 1CLLIMI,IFOUND,IERROR) C C PURPOSE--DEFINE THE UPPER BOUND OF THE LEFT-MOST CLASS C FOR HORIZONTAL VARIABLE OR VERTICAL VARIABLE OR BOTH C FOR DISTRIBUTIONAL PLOTS (E.G., HISTOGRAMS). C THE 2 UPPER LIMITS (ONE FOR THE X AXIS VARIABLE C AND ONE FOR THE Y AXIS VARIABLE) C ARE CONTAINED IN THE SECOND AND FOURTH ELEMENTS OF THE C 4-ELEMENT VECTOR CLLIMI(.). C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --IARGT (A HOLLERITH VECTOR) C --ARG (A FLOATING POINT VECTOR) C --NUMARG C OUTPUT ARGUMENTS--CLLIMI (A 4-ELEMENT FLOATING POINT VECTOR C IN WHICH EACH ELEMENT IS AS FOLLOWS-- C 1) LOWER BOUND FOR HORIZONTAL VARIABLE C (NOT AFFECTED) C 2) UPPER BOUND FOR HORIZONTAL VARIABLE C 3) LOWER BOUND FOR VERTICAL VARIABLE C (NOT AFFECTED) C 4) UPPER BOUND FOR VERTICAL VARIABLE C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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 --MAY 1981. C UPDATED --OCTOBER 1981. C UPDATED --MAY 1982. 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 DIMENSION CLLIMI(4) 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 C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE HORIZONTAL VARIABLE UPPER BOUND IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XUPP')GOTO1100 GOTO1199 C 1100 CONTINUE IF(NUMARG.EQ.1)GOTO1110 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1120 GOTO1110 C 1110 CONTINUE IFOUND='YES' CLLIMI(2)=CPUMAX C IF(IFEEDB.EQ.'OFF')GOTO1119 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT('THE HORIZONTAL AXIS VARIABLE UPPER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT('SO THAT IT WILL BE XBAR + 6*XSD') CALL DPWRST('XXX','BUG ') 1119 CONTINUE GOTO1900 C 1120 CONTINUE IFOUND='YES' CLLIMI(2)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1125) 1125 FORMAT('THE HORIZONTAL AXIS VARIABLE UPPER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1126) 1126 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1127)CLLIMI(1) 1127 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1129 CONTINUE GOTO1900 C 1199 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE VERTICAL VARIABLE UPPER BOUND IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YUPP')GOTO1200 GOTO1299 C 1200 CONTINUE IF(NUMARG.EQ.1)GOTO1210 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1220 GOTO1210 C 1210 CONTINUE IFOUND='YES' CLLIMI(4)=CPUMAX C IF(IFEEDB.EQ.'OFF')GOTO1219 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT('THE VERTICAL AXIS VARIABLE UPPER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217) 1217 FORMAT('SO THAT IT WILL BE YBAR + 6*YSD') CALL DPWRST('XXX','BUG ') 1219 CONTINUE GOTO1900 C 1220 CONTINUE IFOUND='YES' CLLIMI(4)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1229 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1225) 1225 FORMAT('THE VERTICAL AXIS VARIABLE UPPER BOUND ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1226) 1226 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1227)CLLIMI(4) 1227 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1229 CONTINUE GOTO1900 C 1299 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE UPPER BOUNDS FOR BOTH VARIABLES ARE TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XYUP')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YXUP')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'UPPE')GOTO1300 GOTO1399 C 1300 CONTINUE IF(NUMARG.EQ.1)GOTO1310 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1320 GOTO1310 C 1310 CONTINUE IFOUND='YES' CLLIMI(2)=CPUMAX CLLIMI(4)=CPUMAX C IF(IFEEDB.EQ.'OFF')GOTO1319 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1315) 1315 FORMAT('THE UPPER BOUNDS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1316) 1316 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1317) 1317 FORMAT('SO THAT THEY WILL BE AVERAGE + 6*SD') CALL DPWRST('XXX','BUG ') 1319 CONTINUE GOTO1900 C 1320 CONTINUE IFOUND='YES' CLLIMI(2)=ARG(NUMARG) CLLIMI(4)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1329 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1325) 1325 FORMAT('THE UPPER BOUNDS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1326) 1326 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1327)CLLIMI(2) 1327 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1329 CONTINUE GOTO1900 C 1399 CONTINUE C 1900 CONTINUE RETURN END SUBROUTINE DPCLWI(IHARG,IARGT,ARG,NUMARG, 1CLWIDT,IFOUND,IERROR) C C PURPOSE--DEFINE THE CLASS WIDTH C FOR HORIZONTAL VARIABLE OR VERTICAL VARIABLE OR BOTH C FOR DISTRIBUTIONAL PLOTS (E.G., HISTOGRAMS). C THE 2 CLASS WIDTHS (ONE FOR THE X AXIS VARIABLE C AND ONE FOR THE Y AXIS VARIABLE) C ARE CONTAINED IN THE FIRST AND SECOND ELEMENTS OF THE C 2-ELEMENT VECTOR CLWIDT(.). C INPUT ARGUMENTS--IHARG (A HOLLERITH VECTOR) C --IARGT (A HOLLERITH VECTOR) C --ARG (A FLOATING POINT VECTOR) C --NUMARG C OUTPUT ARGUMENTS--CLWIDT (A 2-ELEMENT FLOATING POINT VECTOR C IN WHICH EACH ELEMENT IS AS FOLLOWS-- C 1) CLASS WIDTH FOR HORIZONTAL VARIABLE C 2) CLASS WIDTH FOR VERTICAL VARIABLE C --IFOUND ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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 --MAY 1981. C UPDATED --MAY 1982. 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 DIMENSION CLWIDT(2) 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 C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE HORIZONTAL VARIABLE CLASS WIDTH IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XWID')GOTO1100 GOTO1199 C 1100 CONTINUE IF(NUMARG.EQ.1)GOTO1110 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1120 GOTO1110 C 1110 CONTINUE IFOUND='YES' CLWIDT(1)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1119 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1115) 1115 FORMAT('THE HORIZONTAL AXIS VARIABLE CLASS WIDTH ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1116) 1116 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1117) 1117 FORMAT('SO THAT IT WILL BE 0.3*XSD') CALL DPWRST('XXX','BUG ') 1119 CONTINUE GOTO1900 C 1120 CONTINUE IFOUND='YES' CLWIDT(1)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1129 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1125) 1125 FORMAT('THE HORIZONTAL AXIS VARIABLE CLASS WIDTH ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1126) 1126 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1127)CLWIDT(1) 1127 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1129 CONTINUE GOTO1900 C 1199 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE VERTICAL VARIABLE CLASS WIDTH IS TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YWID')GOTO1200 GOTO1299 C 1200 CONTINUE IF(NUMARG.EQ.1)GOTO1210 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1220 GOTO1210 C 1210 CONTINUE IFOUND='YES' CLWIDT(2)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1219 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1215) 1215 FORMAT('THE VERTICAL AXIS VARIABLE CLASS WIDTH ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1216) 1216 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1217) 1217 FORMAT('SO THAT IT WILL BE 0.3*YSD') CALL DPWRST('XXX','BUG ') 1219 CONTINUE GOTO1900 C 1220 CONTINUE IFOUND='YES' CLWIDT(2)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1229 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1225) 1225 FORMAT('THE VERTICAL AXIS VARIABLE CLASS WIDTH ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1226) 1226 FORMAT('(FOR DISTRIBUTIONAL PLOTS) HAS JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1227)CLWIDT(2) 1227 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1229 CONTINUE GOTO1900 C 1299 CONTINUE C C ************************************************************ C ** TREAT THE CASE WHEN ** C ** THE CLASS WIDTHS FOR BOTH VARIABLES ARE TO BE CHANGED ** C ************************************************************ C IF(NUMARG.GE.1.AND.IHARG(1).EQ.'XYWI')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'YXWI')GOTO1300 IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WIDT')GOTO1300 GOTO1399 C 1300 CONTINUE IF(NUMARG.EQ.1)GOTO1310 IF(IARGT(NUMARG).EQ.'NUMB')GOTO1320 GOTO1310 C 1310 CONTINUE IFOUND='YES' CLWIDT(1)=CPUMIN CLWIDT(2)=CPUMIN C IF(IFEEDB.EQ.'OFF')GOTO1319 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1315) 1315 FORMAT('THE CLASS WIDTHS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1316) 1316 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1317) 1317 FORMAT('SO THAT THEY WILL BE 0.3*SD') CALL DPWRST('XXX','BUG ') 1319 CONTINUE GOTO1900 C 1320 CONTINUE IFOUND='YES' CLWIDT(1)=ARG(NUMARG) CLWIDT(2)=ARG(NUMARG) C IF(IFEEDB.EQ.'OFF')GOTO1329 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1325) 1325 FORMAT('THE CLASS WIDTHS (FOR DISTRIBUTIONAL PLOTS) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1326) 1326 FORMAT('FOR BOTH VARIABLES HAVE JUST BEEN SET') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,1327)CLWIDT(1) 1327 FORMAT('TO ',E15.7) CALL DPWRST('XXX','BUG ') 1329 CONTINUE GOTO1900 C 1399 CONTINUE C 1900 CONTINUE RETURN END SUBROUTINE DPCMGP(Y,N, 1XTEMP,MAXNXT, 1GAMMA,A,GAMMSD,THRESH, 1TEMP1,TEMP2,TEMP3,ITEMP1, 1IGEPDF,ICAPSW,ICAPTY, 1PPOTTO, 1ISUBRO,IBUGA3,IERROR) C C PURPOSE--THIS ROUTINE COMPUTES THE CME C ESTIMATES FOR THE GENERALIZED PARETO DISTRIBUTION. C THIS IS USED IN EXTREME VALUE APPLICATIONS. C EXAMPLE--CME Y C REFERENCE--XX C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. 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--98/5 C ORIGINAL VERSION--MAY 1998. C UPDATED --JUNE 2004. SUPPORT FOR IGEPDF C UPDATED --APRIL 2005. A NUMBER OF ENHANCEMENTS C C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES------------------- C CHARACTER*4 IGEPDF CHARACTER*4 ICAPSW CHARACTER*4 ICAPTY CHARACTER*4 ISUBRO CHARACTER*4 IBUGA3 CHARACTER*4 IERROR C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN CHARACTER*4 IWRITE CHARACTER*8 ISIGN1 CHARACTER*8 ISIGN2 C C--------------------------------------------------------------------- C DIMENSION Y(*) DIMENSION XTEMP(*) C DIMENSION TEMP1(*) DIMENSION TEMP2(*) DIMENSION TEMP3(*) DIMENSION ITEMP1(*) C DOUBLE PRECISION DGAMMA DOUBLE PRECISION DA DOUBLE PRECISION DB EXTERNAL DGAMMA 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 PI / 3.1415926535/ DATA MINSIZ /5/ C C-----START POINT----------------------------------------------------- C ISUBN1='DPCM' ISUBN2='GP ' C IERROR='NO' C IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CMGP')THEN WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,51) 51 FORMAT('**** AT THE BEGINNING OF DPCMGP--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,52)IBUGA3 52 FORMAT('IBUGA3 = ',A4) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,55)N,PPOTTO 55 FORMAT('N,PPOTTO = ',I8,2X,G15.7) 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 ENDIF C C ******************************************** C ** STEP 11-- ** C ** CHECK THE INPUT ARGUMENTS FOR ERRORS ** C ******************************************** C ISTEPN='11' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CMGP') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C IF(N.LT.MINSIZ)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1111) 1111 FORMAT('***** ERROR IN CME GENERALIZED PARETO ', 1 'ESTIMATION--') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1112) 1112 FORMAT(' THE NUMBER OF OBSERVATIONS IS LESS THAN THE') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1113)MINSIZ 1113 FORMAT(' MINIMUM REQUIRED OF ',I8) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1114)N 1114 FORMAT('THE NUMBER OF OBSERVATIONS = ',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,1111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1133)HOLD 1133 FORMAT(' THE INPUT DATA HAS ALL ELEMENTS EQUAL TO ',G15.7) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 1139 CONTINUE C C ******************************************** C ** STEP 21-- ** C ** CARRY OUT CALCULATIONS ** C ** FOR CME ESTIMATE ** C ** SORT THE DATA ** C ** AND IDENTIFY POINTS ABOVE THE THRESHOLD* C ******************************************** C 2100 CONTINUE C ISTEPN='21' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CMGP') 1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2) C CALL SORT(Y,N,Y) EPS=0.0001 IF(THRESH.LE.0.0)THRESH=Y(1)-EPS DO2110I=1,N IF(Y(I).GT.THRESH)THEN IFRST=I GOTO2119 ENDIF 2110 CONTINUE IFIRST=N+1 2119 CONTINUE C NUSE=N-IFRST+1 IF(NUSE.LT.2)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,2121) 2121 FORMAT(' NO POINTS ARE ABOVE THE THRESHOLD.') CALL DPWRST('XXX','WRIT') WRITE(ICOUT,2123)THRESH 2123 FORMAT(' THRESHOLD = ',G15.7) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,2125)Y(N) 2125 FORMAT(' MAXIMUM DATA POINT = ',G15.7) CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 ENDIF C IF(Y(IFRST).LT.0.0)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,1111) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,2131) 2131 FORMAT(' NEGATIVE VALUES ENCOUNTERED IN THE INPUT DATA.') CALL DPWRST('XXX','WRIT') IERROR='YES' GOTO9000 ENDIF C CALL CMESUB(Y(IFRST),NUSE,SLOPE,R1, 1TEMP1,TEMP2,TEMP3,ITEMP1,GAMMSD) C GAMMA=SLOPE/(1.0+SLOPE) A=R1*(1.0-GAMMA) C IWRITE='OFF' CALL MEAN(Y(IFRST),NUSE,IWRITE,XMEAN,IBUGA3,IERROR) CALL VAR(Y(IFRST),NUSE,IWRITE,XVAR,IBUGA3,IERROR) XSD=SQRT(XVAR) IF(ABS(GAMMA).LE.PPOTTO)THEN SCALE=XSD*SQRT(6.0)/PI ALOC=XMEAN - 0.57722*SCALE ELSEIF(GAMMA.LT.0.0)THEN GAMMA2=-1.0/GAMMA DA=DGAMMA(DBLE((GAMMA2+1.0)/GAMMA2)) DB=DGAMMA(DBLE((GAMMA2+2.0)/GAMMA2)) - DA*DA IF(DB.GT.0.0D0)THEN SCALE=XSD/REAL(DSQRT(DB)) ALOC=XMEAN + SCALE*REAL(DA) ELSE SCALE=0.0 ALOC=0.0 ENDIF ELSE ENDIF C C DEPENDING ON WHAT DEFINITION OF GENERALIZED PARETO PREFERRED, C REVERSE SIGN OF GAMMA. C IF(IGEPDF.EQ.'SIMI')THEN GAMMSV=GAMMA ISIGN1='NEGATIVE' ISIGN2='POSITIVE' ELSE GAMMSV=-GAMMA ISIGN1='POSITIVE' ISIGN2='NEGATIVE' ENDIF C C ********************************* C ** STEP 42-- ** C ** WRITE OUT EVERYTHING ** C ** FOR CME ESTIMATE ** C ********************************* C ISTEPN='42' IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CMGP') 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('') 5002 FORMAT('
') 5003 FORMAT('CME Parameter Estimation for the ', 1 'Generalized Pareto Distribution') 5004 FORMAT('
') 5005 FORMAT('

') WRITE(ICOUT,5001) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5002) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5003) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5005) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START TABLE AND DEFINE A CAPTION C 5011 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
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT(10X,'CME ESTIMATION FOR THE GENERALIZED PARETO ',
     1         'DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT('NUMBER OF OBSERVATIONS                     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4250)THRESH
 4250   FORMAT('THRESHOLD                                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)NUSE
 4252   FORMAT('NUMBER OF OBSERVATIONS ABOVE THE THRESHOLD = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4343)GAMMSV
 4343   FORMAT('ESTIMATE OF SHAPE PARAMETER GAMMA          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4354)GAMMSD
 4354   FORMAT('STANDARD DEVIATION OF GAMMA                = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)A
 4243   FORMAT('SCALE PARAMETER A                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        IF(GAMMA.LT.-PPOTTO)THEN
          WRITE(ICOUT,4500)ISIGN1
 4500     FORMAT('FOR ',A8,' GAMMA, THE GENERALIZED PARETO IS ',
     1           'EQUIVALENT TO ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4501)
 4501     FORMAT('A REVERSE WEIBULL (SET MINMAX MAX) WITH:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4502)GAMMA2
 4502     FORMAT('SHAPE PARAMETER GAMMA                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4504)ALOC
 4504     FORMAT('LOCATION PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4506)SCALE
 4506     FORMAT('SCALE PARAMETER                          = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ABS(GAMMA).LE.PPOTTO)THEN
          WRITE(ICOUT,4600)
 4600     FORMAT('FOR GAMMA = ZERO, THE GENERALIZED PARETO IS ',
     1           'EQUIVALENT TO ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4602)
 4602     FORMAT('AN EXTREME VALUE TYPE I (GUMBEL) WITH:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4604)ALOC
 4604     FORMAT('LOCATION PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4606)SCALE
 4606     FORMAT('SCALE PARAMETER                          = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4700)ISIGN2
 4700     FORMAT('FOR ',A8,' GAMMA, THE GENERALIZED PARETO IS ',
     1           'EQUIVALENT TO ')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4702)
 4702     FORMAT('A (MAXIMUM) EXTREME VALUE TYPE II (FRECHET)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
      ENDIF
      ENDIF
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4941)
 4941   FORMAT('GAMMA, SDGAMMA, AND A WILL BE SAVED AS INTERNAL ',
     1         'PARAMETERS.')
        CALL DPWRST('XXX','BUG ')
        IF(GAMMA.LT.-PPOTTO)THEN
          WRITE(ICOUT,4951)
 4951     FORMAT('THE REVERSE WEIBULL PARAMETERS WILL BE SAVED AS')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4953)
 4953     FORMAT('THE INTERNAL PARAMETERS GAMMA2, LOC, AND SCALE, ',
     1           ' RESPECTIVELY.')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ABS(GAMMA).LT.PPOTTO)THEN
          WRITE(ICOUT,4961)
 4961     FORMAT('THE GUMBEL PARAMETERS WILL BE SAVED AS THE ',
     1           'INTERNAL PARAMETERS LOC AND SCALE, RESPECTIVELY.')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'CMGP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCMGP--')
      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')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCME(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE ONE OF THE FOLLOWING 4
C              CONDITIONAL EXCEEDANCE PLOTS--
C                 CONDITIONAL EXCEEDANCE PLOT Y
C                 CONDITIONAL MEAN EXCEEDANCE PLOT Y (= CME PLOT Y)
C                 CONDITIONAL MEDIAN EXCEEDANCE PLOT Y
C                 CONDITIONAL MIDMEAN EXCEEDANCE PLOT Y
C     NOTE--THERE ARE MANY SYNONYMS FOR THE CME PLOT--
C              YANG PLOT
C              MEAN RESIDUAL LIFE PLOT
C              LIFE EXPECTANCY PLOT
C              MEAN LIFE EXPECTANCY PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--93/12
C     ORIGINAL VERSION--DECEMBER  1993.
C     UPDATED         --DECEMBER  1993. LINFIT ARGS: PROTECT RESSD/DF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION XTEMP4(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),XTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB3),XTEMP2(1))
CCCCC ADD FOLLOWING 2 LINES.  FEBRUARY 1994.
      EQUIVALENCE (GARBAG(IGARB4),XTEMP3(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP4(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.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
      ISUBN1='DPCM'
      ISUBN2='E   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
C
      ICOLR=0
C
C               **************************************************
C               **  TREAT THE COND. ... EXCEEDANCE    PLOT CASE **
C               **************************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CME')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='CME'
C
      IF(ICOM.EQ.'CME')THEN
         IF(NUMARG.GE.1)THEN
            IF(IHARG(1).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO111
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'COND')THEN
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'EXCE'.AND.IHARG(2).EQ.'PLOT')THEN
               ICASPL='SCAT'
               GOTO112
            ENDIF
         ENDIF
C
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'SCAT'.AND.IHARG(2).EQ.'EXCE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='SCAT'
               GOTO113
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'EXCE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO113
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'MEDI'.AND.IHARG(2).EQ.'EXCE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='MEDI'
               GOTO113
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'MIDM'.AND.IHARG(2).EQ.'EXCE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='MIDM'
               GOTO113
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'YANG')THEN
         IF(NUMARG.GE.1)THEN
            IF(IHARG(1).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO111
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'LIFE')THEN
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'EXPE'.AND.IHARG(2).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO112
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'MEAN')THEN
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'LIFE'.AND.IHARG(2).EQ.'EXPE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO113
            ENDIF
         ENDIF
      ENDIF
C
      IF(ICOM.EQ.'MEAN')THEN
         IF(NUMARG.GE.3)THEN
            IF(IHARG(1).EQ.'RESI'.AND.IHARG(2).EQ.'LIFE'.AND.
     1      IHARG(3).EQ.'PLOT')THEN
               ICASPL='MEAN'
               GOTO113
            ENDIF
         ENDIF
      ENDIF
C
      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
  113 CONTINUE
      ILASTC=3
      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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL 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)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************************
C               **  STEP 4--                                                **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)     **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.                  **
C               **************************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A CONDITIONAL ... EXCEEDANCE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      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)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      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
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPCME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CME')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST  VARIABLE ARE NOT DATA POINTS             **
C               **  BUT ALREADY-COMPUTED FREQUENCIES,               **
C               **  AND THE VALUES IN THE SECOND VARIABLE           **
C               **  ARE THE CORRESPONDING X VALUES FOR EACH         **
C               **  FREQUENCY.  IF WE HAVE THE 2-VARIABLE CASE,     **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO590
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CONDITIONAL ... EXCEEDANCE PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,IWIDTH)
  564 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               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL 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,IERRO4)
      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
      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)
  660 CONTINUE
      NLOCAL=J
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CME')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CME')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DPCME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,NPLOTP,NPLOTV
 5112 FORMAT('ICASPL,NUMV2,NPLOTP,NPLOTV = ',A4,I8,2X,2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO5190
      DO5115I=1,NPLOTP
      WRITE(ICOUT,5116)I,Y(I),X(I),D(I)
 5116 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 5115 CONTINUE
 5190 CONTINUE
C
      MAXNT1=MAXOBV
      MAXNT2=MAXOBV
      CALL DPCME2(Y1,NLOCAL,ICASPL,XTEMP1,MAXNT1,XTEMP2,MAXNT2,
CCCCC ADD FOLLOWING LINE.  FEBRUARY 1994
     1XTEMP3,XTEMP4,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               ****************************************
C               **  STEP 10--                         **
C               **  COMPUTE SLOPE ESTIMATES OF THE    **
C               **  RESULTING TRACE                   **
C               ****************************************
C
      IWRITE='OFF'
      ISUBN0='DPPP'
      CALL LINFIT(Y,X,NPLOTP,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
C
      IH='CMEC'
      IH2='C   '
      VALUE0=CCXY
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='CMEA'
      IH2='0   '
      VALUE0=ALPHA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='CMEA'
      IH2='1   '
      VALUE0=BETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDCM'
      IH2='EA0 '
      VALUE0=SDALPH
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDCM'
      IH2='EA1 '
      VALUE0=SDBETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='CMER'
      IH2='ESSD'
      VALUE0=XRESSD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='CMER'
      IH2='ESDF'
      VALUE0=XRESDF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CME')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCME2(Y,N,ICASPL,XTEMP1,MAXNT1,XTEMP2,MAXNT2,
CCCCC ADD FOLLOWING LINE.  FEBRUARY 1994.
     1Z,ZITEMS,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE ONE OF THE FOLLOWING 4
C              CONDITIONAL EXCEEDANCE PLOTS--
C                 CONDITIONAL EXCEEDANCE PLOT Y
C                 CONDITIONAL MEAN EXCEEDANCE PLOT Y (= CME PLOT Y)
C                 CONDITIONAL MEDIAN EXCEEDANCE PLOT Y
C                 CONDITIONAL MIDMEAN EXCEEDANCE PLOT Y
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--93/12
C     ORIGINAL VERSION--DECEMBER   1993.
C     UPDATED         --FEBRUARY   1994. HANDLE TIES CORRECTLY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
CCCCC FEBRUARY 1994.  ADD FOLLOWING 2 LINES
      DIMENSION Z(*)
      DIMENSION ZITEMS(*)
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='DPCM'
      ISUBN2='E2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCME2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CME2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPCME2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,N,NPLOTV
   72 FORMAT('ICASPL,N,NPLOTV = ',A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO90
      DO85I=1,N
      WRITE(ICOUT,86)I,Y(I)
   86 FORMAT('I,Y(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   90 CONTINUE
CCCCC FOLLOWING ALGORITHM UPDATED TO HANDLE TIES CORRECTLY.  
CCCCC FIRST,, DETERMINE IF TIES EXIST AND BRANCH TO DISTINCT SECTION
CCCCC IF THEY DO.  FEBRUARY 1994.
C
C               ****************************************
C               **  STEP 1A--                         **
C               **  DETERMINE IF TIES EXIST.          **
C               ****************************************
C
      DO99I=1,N
      ZITEMS(I)=0.0
 99   CONTINUE
      NZ=0
      DO100I=1,N
        IF(I.EQ.1)GOTO130
        DO120J=1,NZ
          IF(Y(I).EQ.Z(J))THEN
            ZITEMS(J)=ZITEMS(J)+1.0
            GOTO100
          ENDIF
 120   CONTINUE
 130   CONTINUE
       NZ=NZ+1
       Z(NZ)=Y(I)
       ZITEMS(J)=1.0
 100  CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CME2')GOTO190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,171)
  171 FORMAT('***** AFTER CHECKING FOR TIES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,172)N,NZ
  172 FORMAT('N,NZ = ',I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO190
      DO185I=1,NZ
      WRITE(ICOUT,186)I,Z(I)
  186 FORMAT('I,Z(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
  185 CONTINUE
  190 CONTINUE
C
      IF(NZ.LT.N)GOTO2000
C
C               ****************************************
C               **  CASE WITH NO TIES                 **
C               ****************************************
C
C               ****************************************
C               **  STEP 1--                          **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      CALL SORT(Y,N,Y)
C
      IWRITE='OFF'
      J=0
      NM1=N-1
      DO1100I=1,NM1
         Y0=Y(I)
         IP1=I+1
C
         NTEMP1=0
         DO1200K=IP1,N
            NTEMP1=NTEMP1+1
            XTEMP1(NTEMP1)=Y(K)-Y0
 1200    CONTINUE
C
         IF(ICASPL.EQ.'SCAT')THEN
            DO1210L=1,NTEMP1
               J=J+1
               Y2(J)=XTEMP1(L)
               X2(J)=Y0
               D2(J)=I
 1210    CONTINUE
C
         ELSEIF(ICASPL.EQ.'MEAN')THEN
            CALL MEAN(XTEMP1,NTEMP1,IWRITE,XMEAN,IBUGG3,IERROR)
            J=J+1
            Y2(J)=XMEAN
            X2(J)=Y0
            D2(J)=1.0
C
         ELSEIF(ICASPL.EQ.'MEDI')THEN
            CALL MEDIAN(XTEMP1,NTEMP1,IWRITE,XTEMP2,MAXNT2,XMED,
     1                  IBUGG3,IERROR)
            J=J+1
            Y2(J)=XMED
            X2(J)=Y0
            D2(J)=1.0
C
         ELSEIF(ICASPL.EQ.'MIDM')THEN
            IF(NTEMP1.EQ.1)THEN
              XMIDM=XTEMP1(1)
            ELSE
              CALL MIDMEA(XTEMP1,NTEMP1,IWRITE,XTEMP2,MAXNT2,XMIDM,
     1                  IBUGG3,IERROR)
            ENDIF
            J=J+1
            Y2(J)=XMIDM
            X2(J)=Y0
            D2(J)=1.0
         ENDIF
C
 1100 CONTINUE
      N2=J
      NPLOTV=2
      GOTO9000
C
 2000 CONTINUE
C
C               ****************************************
C               **  CASE WITH TIES                    **
C               ****************************************
C
C               ****************************************
C               **  STEP 1--                          **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      CALL SORTC(Z,ZITEMS,NZ,Z,ZITEMS)
C
      IWRITE='OFF'
      J=0
      NM1=NZ-1
      DO2100I=1,NM1
         Z0=Z(I)
         IP1=I+1
C
         NTEMP1=0
         IF(ICASPL.EQ.'SCAT')THEN
           DO2200K=IP1,NZ
             NTEMP1=NTEMP1+1
             XTEMP1(NTEMP1)=Z(K)-Z0
 2200      CONTINUE
         ELSEIF(ICASPL.EQ.'MEAN')THEN
           ATEMP=0.0
           DO2210K=IP1,NZ
             NTEMP1=NTEMP1+1
             XTEMP1(NTEMP1)=Z(K)-Z0
             XTEMP2(NTEMP1)=ZITEMS(K)
 2210      CONTINUE
         ELSEIF(ICASPL.EQ.'MEDI'.OR.ICASPL.EQ.'MIDM')THEN
           DO2220K=IP1,NZ
             NITEMS=INT(ZITEMS(K)+0.5)
             DO2225KK=1,NITEMS
               NTEMP1=NTEMP1+1
               XTEMP1(NTEMP1)=Z(K)-Z0
 2225        CONTINUE
 2220      CONTINUE
         ENDIF
C
         IF(ICASPL.EQ.'SCAT')THEN
            DO2310L=1,NTEMP1
               J=J+1
               Y2(J)=XTEMP1(L)
               X2(J)=Z0
               D2(J)=I
 2310      CONTINUE
C
         ELSEIF(ICASPL.EQ.'MEAN')THEN
            IF(NTEMP1.EQ.1)THEN
              XMEAN=XTEMP1(1)
            ELSE
              CALL WEMEAN(XTEMP1,XTEMP2,NTEMP1,IWRITE,XMEAN,
     1                  IBUGG3,IERROR)
            ENDIF
            J=J+1
            Y2(J)=XMEAN
            X2(J)=Z0
            D2(J)=1.0
C
         ELSEIF(ICASPL.EQ.'MEDI')THEN
            CALL MEDIAN(XTEMP1,NTEMP1,IWRITE,XTEMP2,MAXNT2,XMED,
     1                  IBUGG3,IERROR)
            J=J+1
            Y2(J)=XMED
            X2(J)=Z0
            D2(J)=1.0
C
         ELSEIF(ICASPL.EQ.'MIDM')THEN
            IF(NTEMP1.EQ.1)THEN
              XMIDM=XTEMP1(1)
            ELSE
              CALL MIDMEA(XTEMP1,NTEMP1,IWRITE,XTEMP2,MAXNT2,XMIDM,
     1                  IBUGG3,IERROR)
            ENDIF
            J=J+1
            Y2(J)=XMIDM
            X2(J)=Z0
            D2(J)=1.0
         ENDIF
C
 2100 CONTINUE
      N2=J
      NPLOTV=2
      GOTO9000
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CME2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCME2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,IERROR
 9012 FORMAT('ICASPL,N,IERROR = ',A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N2,NPLOTV
 9014 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCMPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICAPSW,ICAPTY,
     1IFORSW,
     1ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A CONSENSUS MEAN PLOT--
C              THE COMMAND HAS THE FOLLOWING FORMAT:
C                  CONSENSUS MEAN PLOT Y X 
C              OR
C                  CONSENSUS MEAN PLOT YMEAN YSD NI
C              THIS PLOT DISPLAYS THE RESULTS OF A CONSENSUS MEAN ANALYSIS.
C              IT IS USEFUL FOR PROVIDING A COMPARISON OF THE VARIOUS
C              METHODS OF COMPUTING CONSENSUS MEANS.
C     EXAMPLE--CONSENSUS MEAN PLOT Y X
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
C     UPDATED         --OCTOBER   2002. ADD ICAPSW, ICAPTY TO CALL
C                                       LIST (PASS TO DPCMP2)
C     UPDATED         --MARCH     2006. ADD IFORSW TO CALL LIST
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IFORSW
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IH
      CHARACTER*4 IH1
      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
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)
      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
C
C-----COMMON----------------------------------------------------------
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
      IERROR='NO'
      IFOUND='NO'
C
      ISUBN1='DPCM'
      ISUBN2='PL  '
C
      ICASPL='CMPL'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=3
      MINN2=2
C
      ICOLH=0
C
C               *******************************************
C               **  TREAT THE CONSENSUS MEAN PLOT CASE   **
C               *******************************************
C
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPCMPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   52   FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53   FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)MAXN
   54   FORMAT('MAXN = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'PLOT')
     1   GOTO112
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               **  AT LEAST 2 REQUIRED                              **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 2.1--                         **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='2.1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CMPL')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               **************************************************
C               **  STEP 2.2--                                  **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **************************************************
C
      ISTEPN='2.2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.GE.2.AND.NUMV2.LE.3)GOTO2290
C
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPCMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      ILLEGAL SYNTAX--THE NUMBER OF VARIABLES TO BE ',
     1       'INCLUDED AS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      ARGUMENTS IN A CONSENSUS MEAN PLOT COMMAND MUST ',
     1       'BE AT LEAST 2 AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)NUMV2
 2216 FORMAT('      AT MOST 3;  SUCH WAS NOT THE CASE HERE.  NUMV2 = ',
     1       I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)
 2217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2218)(IANS(I),I=1,MIN(IWIDTH,80))
 2218 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               ***************************************
C               **  STEP 2.3                         **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               ***************************************
C
      ISTEPN='2.3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2300I=1,NUMV2
      IH1=IHARG(I)
      IH2=IHARG2(I)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH1,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(I.EQ.1)THEN
        ICOL1=IVALUE(ILOCV)
        N1=IN(ILOCV)
        IHLEFT=IH1
        IHLEF2=IH2
      ELSEIF(I.EQ.2)THEN
        ICOL2=IVALUE(ILOCV)
        N2=IN(ILOCV)
        IHRIGH=IH1
        IHRIG2=IH2
      ELSEIF(I.EQ.3)THEN
        ICOL3=IVALUE(ILOCV)
        N3=IN(ILOCV)
        IHRI21=IH1
        IHRI22=IH2
      ENDIF
 2300 CONTINUE
C
C               **************************************************
C               **  STEP 2.4--                                  **
C               **  CHECK THAT ALL ARGUMENTS                    **
C               **  HAVE THE SAME NUMBER OF OBSERVATIONS.       **
C               **************************************************
C
      ISTEPN='2.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.NE.N1)GOTO2410
      IF(NUMV2.EQ.3.AND.(N1.NE.N3))GOTO2410
      GOTO2490
C
 2410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPCMPL--FOR A CONSENSUS MEAN PLOT, ALL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)
 2413 FORMAT('      VARIABLES MUST HAVE THE SAME NUMBER OF ELEMENTS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2415)
 2415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2421)N1
 2421 FORMAT('THE FIRST  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2422)N2
 2422 FORMAT('THE SECOND VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.LE.2)GOTO2425
      WRITE(ICOUT,2423)N3
 2423 FORMAT('THE THIRD  VARIABLE HAD ',I8,' ELEMENTS;')
      CALL DPWRST('XXX','BUG ')
 2425 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2427)
 2427 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2428)(IANS(I),I=1,MIN(IWIDTH,80))
 2428 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
C
C               ******************************************************
C               **  STEP 2.5--                                      **
C               **  CHECK THAT VARIABLES HAVE AT LEAST 1 ELEMENT    **
C               ******************************************************
C
 4100 CONTINUE
      ISTEPN='2.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.LT.MINN2)THEN
        WRITE(ICOUT,2511)
 2511   FORMAT('***** ERROR IN DPCMPL--THE NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2513)N1
 2513   FORMAT('      FOR THE VARIABLES MUST BE AT LEAST ',I8,';')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2515)
 2515   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2516)N1
 2516   FORMAT('           THE VARIABLES  HAVE ',I8,' OBSERVATIONS;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2520)
 2520   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2521)(IANS(I),I=1,MIN(80,IWIDTH))
 2521   FORMAT('      ',100A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************************
C               **  STEP 3--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FOR  EACH OF THE RESPONSE VARIABLES   **
C               **  EXTRACT THE DATA SUBSET                    **
C               *************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CMPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3010
      IF(ICASEQ.EQ.'SUBS')GOTO3020
      IF(ICASEQ.EQ.'FOR')GOTO3030
C
 3010 CONTINUE
      DO3015I=1,N1
      ISUB(I)=1
 3015 CONTINUE
      NQ=N1
      GOTO3050
C
 3020 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3050
C
 3030 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3050
C
 3050 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO3060I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3060
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
      IF(NUMV2.LE.2)GOTO3060
      IJ=MAXN*(ICOL3-1)+I
      IF(ICOL3.LE.MAXCOL)Y3(J)=V(IJ)
      IF(ICOL3.EQ.MAXCP1)Y3(J)=PRED(I)
      IF(ICOL3.EQ.MAXCP3)Y3(J)=RES(I)
      IF(ICOL3.EQ.MAXCP3)Y3(J)=YPLOT(I)
      IF(ICOL3.EQ.MAXCP4)Y3(J)=XPLOT(I)
      IF(ICOL3.EQ.MAXCP5)Y3(J)=X2PLOT(I)
      IF(ICOL3.EQ.MAXCP6)Y3(J)=TAGPLO(I)
C
 3060 CONTINUE
      NLOCAL=J
C
 
C
C               *******************************************************
C               **  STEP 8--                                         **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CMPL')GOTO5099
      CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      WRITE(ICOUT,5001)NLOCAL,ICASPL
 5001 FORMAT('NLOCAL,ICASPL=',I5,1X,A4)
      CALL DPWRST('XXX','BUG ')
 5099 CONTINUE
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     MARCH 2006.  ADD IFORSW TO CALL LIST.
C
      CALL DPCMP2(Y1,Y2,Y3,NLOCAL,ICASPL,NUMV2,
     1Z1,Z2,Z3,Z4,Z5,Z6,Z7,IZ,
     1IHLEFT,IHLEF2,
     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,
     1Y,X,D,
CCCCC OCTOBER 2002. ADD ICAPSW, ICAPTY TO CALL LIST
     1ICAPSW,ICAPTY,IFORSW,
     1NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGG2.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,IBUGG3,IERROR)
C
      IH='S2PO'
      IH2='OOL '
      VALUE0=S2WPOO
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='T1ST'
      IH2='DERR'
      VALUE0=SET1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='T2ST'
      IH2='DERR'
      VALUE0=SET2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SEME'
      IH2='AN  '
      VALUE0=XSE
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SES2'
      IH2='    '
      VALUE0=XSES2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='BIAS'
      IH2='ALLO'
      VALUE0=ABIAS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SEDF'
      IH2='    '
      VALUE0=REAL(ISEDF)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MPME'
      IH2='AN  '
      VALUE0=XMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MPS2'
      IH2='    '
      VALUE0=S2BMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SEMP'
      IH2='    '
      VALUE0=SEMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MMPM'
      IH2='EAN '
      VALUE0=XMMPS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MMPS'
      IH2='2   '
      VALUE0=S2BMMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SEMM'
      IH2='P   '
      VALUE0=SEMMP
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MLME'
      IH2='AN  '
      VALUE0=XMLS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='MLS2'
      IH2='    '
      VALUE0=S2BMLS
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SEML'
      IH2='    '
      VALUE0=SEML
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='BOBM'
      IH2='EAN '
      VALUE0=ASM
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='BOBS'
      IH2='2   '
      VALUE0=ASB
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='BOBS'
      IH2='2W  '
      VALUE0=SW
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='BOBK'
      IH2='U   '
      VALUE0=AKU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='GDME'
      IH2='AN  '
      VALUE0=XGD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='GDS2'
      IH2='    '
      VALUE0=XGDS2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 9--   **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CMPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NLOCAL,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NLOCAL
 9041 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCMP2(Y1,Y2,Y3,NZ,ICASPL,NUMV2,
     1DAT,DX,T,THAT,W,AMEAN,ASD,N,
     1IHLEFT,IHLEF2,
     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,
     1Y,X,D,
CCCCC OCTOBER 2002. ADD ICAPSW, ICAPTY TO CALL LIST
CCCCC MARCH   2006. ADD IFORSW TO CALL LIST
     1ICAPSW,ICAPTY,IFORSW,
     1N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A CONSENSUS MEAN PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--2001/8
C     ORIGINAL VERSION--AUGUST    2001.
C     UPDATED  VERSION--APRIL     2002. PRINT OUT ORDER OF METHODS ON
C                                       PLOT
C     UPDATED  VERSION--OCTOBER   2002. ADD ICAPSW, ICAPTY TO CALL
C                                       LIST (PASS TO DPMAN2)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASPL
      CHARACTER*4 IFORSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION XMID(10)
      DOUBLE PRECISION DXLOW(10)
      DOUBLE PRECISION DXHIGH(10)
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION AMEAN(*)
      DIMENSION ASD(*)
      DIMENSION DAT(*)
      DOUBLE PRECISION DX(*)
      DOUBLE PRECISION T(*)
      DOUBLE PRECISION W(*)
      DOUBLE PRECISION THAT(*)
      DIMENSION N(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
      INCLUDE 'DPCOF2.INC'
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
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='DPCM'
      ISUBN2='P2  '
C
      IERROR='NO'
      IERRF2='NO'
      ISUBN0='CMP2'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NZ.GE.2)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCMP2--THE NUMBER OF OBSERVATIONS ',
     1       'MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)NZ
   34 FORMAT('      AT LEAST 2; THE ENTERED NUMBER OF OBSERVATIONS ',
     1       'HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CMP2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPCMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NZ,N2,NPLOTV,NUMV2
   72 FORMAT('ICASPL,NZ,N2,NPLOTV,NUMV2 = ',A4,2X,4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
      DO81I=1,NZ
      WRITE(ICOUT,82)I,Y1(I),Y2(I),Y3(I)
   82 FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
   81 CONTINUE
   83 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 1--                          **
C               **  CALL DPMAN2 TO OBTAIN CONSENSUS   **
C               **  MEAN ESTIMATES.                   **
C               ****************************************
C
      IWRITE='OFF'
CCCCC IWRITE='ON'
      CALL DPMAN2(Y1,Y2,Y3,NZ,NUMV2,
     1DAT,DX,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,
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,IBUGG3,IERROR)
C
C               ****************************************
C               **  STEP 2--                          **
C               **  READ VALUES BACK FROM FILE        **
C               ****************************************
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,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IROW=0
      DO200I=1,11
        READ(IOUNI2,'(3(E15.7,2X))',END=209,ERR=205)
     1      XMID(I),DXLOW(I),DXHIGH(I)
        IROW=IROW+1
  200 CONTINUE
C
      GOTO209
  205 CONTINUE
      WRITE(ICOUT,999)
      WRITE(ICOUT,206)
  206 FORMAT('***** ERROR IN CONSENSUS MEAN PLOT: UNABLE TO READ ',
     1'VALUES FROM DPST2F.DAT FILE.')
      CALL DPWRST('XXX','BUG ')
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
      IERROR='YES'
      GOTO9000
C
  209 CONTINUE
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGG3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 3--                          **
C               **  CREATE THE X, Y, D ARRAYS FOR     **
C               **  PLOTTING                          **
C               ****************************************
C
CCCCC IBOB=1
CCCcC IF(IROW.LT.8)IBOB=0
C
      N2=0
      DO300IINDX=1,IROW
        N2=N2+1
        X(N2)=REAL(IINDX)
        Y(N2)=XMID(IINDX)
        D(N2)=1.0
C
        N2=N2+1
        X(N2)=REAL(IINDX)
        Y(N2)=DXLOW(IINDX)
        D(N2)=2.0
C
        N2=N2+1
        X(N2)=REAL(IINDX)
        Y(N2)=DXHIGH(IINDX)
        D(N2)=2.0
  300 CONTINUE
C
 8000 CONTINUE
      NPLOTV=3
      IF(IPRINT.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8011)
 8011   FORMAT('The accompying plot has the consensus value and ',
     1         'confidence limits.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8013)
 8013   FORMAT('The ordering of methods on the accompaning consensus ',
     1         'mean plot is:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8021)
 8021   FORMAT('1. Vangel-Rukhin Maximum Likelihood')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8023)
 8023   FORMAT('2. Mandel-Paule')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8025)
 8025   FORMAT('3. Modified Mandel-Paule')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8027)
 8027   FORMAT('4. BOB')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8029)
 8029   FORMAT('5. Schiller-Eberhardt')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8031)
 8031   FORMAT('6. Mean of Means')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8033)
 8033   FORMAT('7. Graybill-Deal')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8035)
 8035   FORMAT('8. Grand Mean')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CMP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NZ,N2,IERROR
 9012 FORMAT('ICASPL,NZ,N2,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9013)N2,J,K
C9013 FORMAT('N2,J,K = ',3I8)
      WRITE(ICOUT,9013)N2
 9013 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9023
      DO9021I=1,NZ
      WRITE(ICOUT,9022)I,Y1(I),Y2(I),Y3(I)
 9022 FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3E12.5)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9023 CONTINUE
      WRITE(ICOUT,9031)N2,NPLOTV
 9031 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y(I),X(I),D(I)
 9036 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCNF2(Y,W,N,X,N2,XTEMP1,XTEMP2,MAXNXT,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES CONFIDENCE LIMITS
C              FOR THE MEAN
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF EQUALLY-SPACED OBSERVATIONS
C                                TO BE SMOOTHED.
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--JULY      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  1994. DPWRST: 'BUG ' => 'WRIT'
C     UPDATED         --FEBRUARY  1994. E FORMAT => G FORMAT
C     UPDATED         --MARCH     1999. DIFFERENCE OF MEANS CASE
C     UPDATED         --FEBRUARY  2003. SUPPORT FOR CUTL..,CUTH..
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --AUGUST    2005. FOR DIFF OF MEANS CASE:
C                                       A) HTML PRINTED OUT WRONG
C                                          VALUES FOR SECOND VARIABLE
C                                       B) ADDED AN ELSE STATEMENT TO
C                                          ACTIVATE THE ASCII OUTPUT
C     UPDATED         --OCTOBER   2006. CALL LIST TO TPPF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION W(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION CONF(10)
      DIMENSION T(10)
      DIMENSION TSDM(10)
      DIMENSION ALOWER(10)
      DIMENSION AUPPER(10)
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='DPCN'
      ISUBN2='F2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPCNF2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)N,IBUGA3
   52   FORMAT('N,IBUGA3 = ',I8,2X,A4)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),W(I),X(I)
   57     FORMAT('I,Y(I),W(I),X(I) = ',I8,3E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,58)ICASAN
   58   FORMAT('ICASAN   = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(ICASAN.EQ.'TWOV')GOTO2000
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR IN DPCNF2--THE NUMBER OF OBSERVATIONS ',
     1         'IN THE RESPONSE VARIABLE IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,112)N
  112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,121)
  121 FORMAT('***** NOTE FROM DPCNF2--THE RESPONSE VARIABLE ',
     1'ONLY HAS 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
  129 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPCNF2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
  139 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE MEAN.                            **
C               **  COMPUTE THE STANDARD DEVIATION.              **
C               **  COMPUTE THE STANDARD DEVIATION OF THE MEAN.  **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
      AN=N
      YSDMEA=YSD/SQRT(AN)
C
C               ***************************************
C               **  STEP 4--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR VARIOUS PROBABILITY VALUES.  **
C               ***************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CONF(1)=50.0
      CONF(2)=75.0
      CONF(3)=90.0
      CONF(4)=95.0
      CONF(5)=99.0
      CONF(6)=99.9
      CONF(7)=99.99
      CONF(8)=99.999
C
      DO1400I=1,8
      PCONF=CONF(I)/100.0
      CDF=0.5+PCONF/2.0
      NM1=N-1
      CALL TPPF(CDF,REAL(NM1),T(I))
      TSDM(I)=T(I)*YSDMEA
      ALOWER(I)=YMEAN-TSDM(I)
      AUPPER(I)=YMEAN+TSDM(I)
 1400 CONTINUE
      CUTL90=ALOWER(3)
      CUTU90=AUPPER(3)
      CUTL95=ALOWER(4)
      CUTU95=AUPPER(4)
      CUTL99=ALOWER(5)
      CUTU99=AUPPER(5)
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
CCCCC OCTOBER 2003: WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
') 5004 FORMAT('

') WRITE(ICOUT,5001) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START TABLE AND DEFINE A CAPTION C 5011 FORMAT('') 5099 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 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5127   FORMAT('      ')
 5139   FORMAT('   ')
 5131   FORMAT('         Confidence
Value (%)')
 5132   FORMAT('         t
Value')
 5133   FORMAT('         t X SD(Mean)')
 5134   FORMAT('         Lower
Limit')
 5135   FORMAT('         Upper
Limit')
 5161   FORMAT('      ')
 5162   FORMAT('          
')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        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,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   ')
 5143   FORMAT('      ')
 5147   FORMAT('      ')
 5151   FORMAT('         ',F8.3)
 5152   FORMAT('         ',G12.6)
 5149   FORMAT('   ')
        DO5180I=1,8
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)T(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)TSDM(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)ALOWER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)AUPPER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
 5180   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('')
 5193   FORMAT('')
 5199   FORMAT('
')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          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 Confidence Limits for the Mean (2-Sided)}')
 8013 FORMAT(A1,'end{center}')
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,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,'Mean: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Standard Deviation: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Standard Deviation of the Mean: & ',G15.7,2X,A1,A1)
 8049 FORMAT(5X,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)YMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)YSDMEA,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}')
        WRITE(ICOUT,8093)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
 8120 FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121 FORMAT(5X,'{',A1,'bf Confidence} & {',A1,'bf t } & & ',
     1       '{',A1,'bf Lower } & {',A1,'bf Upper}',2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Value (',A1,'%) } & {',A1,'bf Value} & {',A1,
     1       'bf t x SD(Mean)} & {',A1,'bf Limit} & {',A1,'bf Limit }',
     1       2X,A1,A1)
 8123 FORMAT(5X,2(F8.3,' & '),2(G12.6,' & '),G12.6,2X,A1,A1)
 8130 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                   IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8130)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8160I=1,8
          WRITE(ICOUT,8123)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8160   CONTINUE
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C PLACEHOLDER FOR RTF FORMAT OUTPUT
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,811)
  811   FORMAT(
     1'                   CONFIDENCE LIMITS FOR MEAN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,812)
  812   FORMAT(
     1'                           (2-SIDED)')
        CALL DPWRST('XXX','WRIT')
 
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,821)N
  821   FORMAT(
     1'          NUMBER OF OBSERVATIONS     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,822)YMEAN
  822   FORMAT(
     1'          MEAN                       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,823)YSD
  823   FORMAT(
     1'          STANDARD DEVIATION         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,824)YSDMEA
  824   FORMAT(
     1'          STANDARD DEVIATION OF MEAN = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,832)
  832   FORMAT(
     1'   CONFIDENCE   T     T X SD(MEAN)     LOWER         UPPER     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,833)
  833   FORMAT(
     1'   VALUE (%)  VALUE                    LIMIT         LIMIT     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,834)
  834   FORMAT(
     1'---------------------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO840I=1,8
          WRITE(ICOUT,841)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I)
  841     FORMAT(
     1'   ',F8.3,F8.3,2X,G12.6,2X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
  840   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      GOTO9000
C
 2000 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1.OR.N2.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DIIFERENCE OF MEANS CONFIDENCE LIMITS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2112)
 2112 FORMAT('      BOTH VARIABLES MUST HAVE AT LEAST 2 OBSERVATIONS.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2113)N
 2113   FORMAT('      SAMPLE SIZE FOR VARIABLE 1 = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2114)N2
 2114   FORMAT('      SAMPLE SIZE FOR VARIABLE 2 = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE MEAN.                            **
C               **  COMPUTE THE STANDARD DEVIATION.              **
C               **  COMPUTE THE STANDARD DEVIATION OF THE MEAN.  **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL MEAN(Y,N,IWRITE,YMEAN1,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD1,IBUGA3,IERROR)
      AN1=N
      YTEMP1=YSD1**2/AN1
C
      CALL MEAN(X,N2,IWRITE,YMEAN2,IBUGA3,IERROR)
      CALL SD(X,N2,IWRITE,YSD2,IBUGA3,IERROR)
      AN2=N2
      YTEMP2=YSD2**2/AN2
C
      YDIFF=YMEAN1-YMEAN2
      YSTERR=SQRT(YTEMP1 + YTEMP2)
      TERM1=(YTEMP1 + YTEMP2)**2
      TERM2=YTEMP1*YTEMP1/(AN1-1.0) + YTEMP2*YTEMP2/(AN2-1.0)
      V=TERM1/TERM2
      IV=INT(V+0.5)
C
C               ***************************************
C               **  STEP 4--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR VARIOUS PROBABILITY VALUES.  **
C               ***************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CONF(1)=50.0
      CONF(2)=75.0
      CONF(3)=90.0
      CONF(4)=95.0
      CONF(5)=99.0
      CONF(6)=99.9
      CONF(7)=99.99
      CONF(8)=99.999
C
      DO2400I=1,8
      PCONF=CONF(I)/100.0
      CDF=0.5+PCONF/2.0
      CALL TPPF(CDF,REAL(IV),T(I))
      TSDM(I)=T(I)*YSTERR
      ALOWER(I)=YDIFF-TSDM(I)
      AUPPER(I)=YDIFF+TSDM(I)
 2400 CONTINUE
      CUTL90=ALOWER(3)
      CUTU90=AUPPER(3)
      CUTL95=ALOWER(4)
      CUTU95=AUPPER(4)
      CUTL99=ALOWER(5)
      CUTU99=AUPPER(5)
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
CCCCC OCTOBER 2003: WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5501   FORMAT('
')
 5504   FORMAT('

')
        WRITE(ICOUT,5501)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5504)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5511   FORMAT('')
 5599   FORMAT('
')
        WRITE(ICOUT,5591)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5593)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5504)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5621   FORMAT('   ')
 5623   FORMAT('      ')
 5627   FORMAT('      ')
 5639   FORMAT('   ')
 5631   FORMAT('         Confidence
Value (%)')
 5632   FORMAT('         t
Value')
 5633   FORMAT('         t X SD(Mean)')
 5634   FORMAT('         Lower
Limit')
 5635   FORMAT('         Upper
Limit')
 5661   FORMAT('      ')
 5662   FORMAT('          
')
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5631)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5632)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5633)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5634)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5635)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5661)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5662)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5641   FORMAT('   ')
 5643   FORMAT('      ')
 5647   FORMAT('      ')
 5651   FORMAT('         ',F8.3)
 5652   FORMAT('         ',G12.6)
 5649   FORMAT('   ')
        DO5680I=1,8
          WRITE(ICOUT,5641)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5651)T(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5652)TSDM(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5652)ALOWER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5643)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5652)AUPPER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5647)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5649)
          CALL DPWRST('XXX','WRIT')
 5680   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5691   FORMAT('')
 5693   FORMAT('')
 5699   FORMAT('
')
        WRITE(ICOUT,5691)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5693)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5699)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8501 FORMAT(A1,'end{verbatim}')
 8503 FORMAT(A1,'begin{table}')
 8507 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8509 FORMAT(A1,'begin{center}')
 8511 FORMAT(5X,'{',A1,'bf Confidence Limits for the Difference ',
     1       'Between Means (2-Sided)}')
 8513 FORMAT(A1,'end{center}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8501)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8503)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8511)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8513)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
 8520 FORMAT(5X,A1,'begin{tabular} {lr}')
 8521 FORMAT(5X,'Number of Observations for Sample 1: & ',I8,2X,A1,A1)
 8522 FORMAT(5X,'Mean for Sample 1: & ',G15.7,2X,A1,A1)
 8523 FORMAT(5X,'Standard Deviation for Sample 1: & ',G15.7,2X,A1,A1)
 8524 FORMAT(5X,'Number of Observations for Sample 2: & ',I8,2X,A1,A1)
 8525 FORMAT(5X,'Mean for Sample 2: & ',G15.7,2X,A1,A1)
 8526 FORMAT(5X,'Standard Deviation for Sample 2: & ',G15.7,2X,A1,A1)
 8527 FORMAT(5X,'Difference Between Two Sample Means: & ',
     1       G15.7,2X,A1,A1)
 8528 FORMAT(5X,'Standard Error: & ',G15.7,2X,A1,A1)
 8549 FORMAT(5X,A1,'end{tabular}')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8520)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8521)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8522)YMEAN1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8523)YSD1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8524)N2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8525)YMEAN2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8526)YSD2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8527)YDIFF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8528)YSTERR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8549)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8591 FORMAT(A1,'end{table}')
 8593 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8593)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
 8620 FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8161 FORMAT(5X,'{',A1,'bf Confidence} & {',A1,'bf t } & & ',
     1       '{',A1,'bf Lower } & {',A1,'bf Upper}',2X,A1,A1)
 8162 FORMAT(5X,'{',A1,'bf Value (',A1,'%) } & {',A1,'bf Value} & {',A1,
     1       'bf t x SD(Mean)} & {',A1,'bf Limit} & {',A1,'bf Limit }',
     1       2X,A1,A1)
 8623 FORMAT(5X,2(F8.3,' & '),2(G12.6,' & '),G12.6,2X,A1,A1)
 8630 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8620)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                   IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8630)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8660I=1,8
          WRITE(ICOUT,8623)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8660   CONTINUE
        WRITE(ICOUT,8549)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8699 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8593)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8699)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C PLACEHOLDER FOR RTF FORMAT OUTPUT
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2811)
 2811   FORMAT(
     1'        CONFIDENCE LIMITS FOR DIFFERENCE BETWEEN MEANS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2812)
 2812   FORMAT(
     1'        (2-SIDED)')
        CALL DPWRST('XXX','WRIT')
 
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2821)N
 2821   FORMAT(
     1'          NUMBER OF OBSERVATIONS FOR SAMPLE 1    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2822)YMEAN1
 2822   FORMAT(
     1'          MEAN FOR SAMPLE 1                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2823)YSD1
 2823   FORMAT(
     1'          STANDARD DEVIATION FOR SAMPLE 1        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,2831)N2
 2831   FORMAT(
     1'          NUMBER OF OBSERVATIONS FOR SAMPLE 2    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2832)YMEAN2
 2832   FORMAT(
     1'          MEAN FOR SAMPLE 2                      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2833)YSD2
 2833   FORMAT(
     1'          STANDARD DEVIATION FOR SAMPLE 2        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,2844)YDIFF
 2844   FORMAT(
     1'          DIFFERENCE BETWEEN 2 SAMPLE MEANS      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2845)YSTERR
 2845   FORMAT(
     1'          STANDARD ERROR                         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2852)
 2852   FORMAT(
     1'   CONFIDENCE   T     T X STDERR       LOWER         UPPER     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2854)
 2854   FORMAT(
     1'   VALUE (%)  VALUE                    LIMIT         LIMIT     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,2856)
 2856   FORMAT(
     1'---------------------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO2860I=1,8
          WRITE(ICOUT,2861)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I)
 2861     FORMAT(
     1'   ',F8.3,F8.3,2X,G12.6,2X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
 2860   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
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 DPCNF2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOCH(YTEMP,XTEMP,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT COCHRAN TEST
C              ANALYSIS OF A RANDOMIZED COMPLETE BLOCK DESIGN
C              WHERE THE OUTCOME CAN BE EITHER "SUCCESS" OR
C              "FAILURE" (OR ANY TWO MUTUALLY EXCLUSIVE OUTCOMES).
C              THESE ARE CODED AS ZERO AND ONE.
C              IN DATAPLOT, THE COLUMNS REPRESENT TREATMENTS AND
C              THE ROWS REPRESENT SUBJECTS.
C     EXAMPLE--COCHRAN TEST Y X1 X2
C     REFERENCE--W. J. CONOVER, 1999, "PRACTICAL NONPARAMETRIC
C                STATISTICS", THIRD EDITION, WILEY, PP. 251-256.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/10
C     ORIGINAL VERSION--OCTOBER   2004.
C     UPDATED         --DECEMBER  2005. RECODE TO USE
C                                         COCHRAN TEST Y X1 X2
C                                       INSTEAD OF
C                                         COCHRAN TEST Y X1 ... XK
C                                       IN ORDER TO BE CONSISTENT
C                                       WITH OTHER DATAPLOT COMMANDS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      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
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
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 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      PARAMETER(MAXCOC=20)
C
      DIMENSION Z(MAXOBV,MAXCOC)
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),Z(1,1))
C
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION XTEMP4(MAXOBV)
      DIMENSION XTEMP5(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE(GARBAG(IGARB1),XTEMP1(1))
      EQUIVALENCE(GARBAG(IGARB2),XTEMP2(1))
      EQUIVALENCE(GARBAG(IGARB3),XTEMP3(1))
      EQUIVALENCE(GARBAG(IGARB4),XTEMP4(1))
      EQUIVALENCE(GARBAG(IGARB5),XTEMP5(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='DPCO'
      ISUBN2='CH  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      MAXV2=2
      MINN2=2
      ICOLH=0
C
C               ******************************************
C               **  TREAT THE COCHRAN TEST CASE         **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPCOCH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUBQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICAPSW,ICAPTY
   53   FORMAT('ICAPSW,ICAPTY = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)MAXNXT
   55   FORMAT('MAXNXT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     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               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL 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 COCHRAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE COCHRAN TEST, THE FIRST ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      RESPONSE VARIABLE) 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)THEN
           WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
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 4 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V' .AND. N1.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** ERROR IN COCHRAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)
 1212   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1214)
 1214   FORMAT('      COCHRAN TEST WAS TO HAVE BEEN CARRIED OUT MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1216)MINN2
 1216   FORMAT('      BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1218)IH11,IH12,N1
 1218   FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
        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(IWIDTH,80))
 1220     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
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'.OR.ISUBRO.EQ.'COCH')
     1CALL 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 THE COCHRAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR THE COCHRAN TEST, THE SECOND ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      FIRST FACTOR (= BLOCK) VARIABLE)  MUST BE A')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      FUNCTION).  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)THEN
           WRITE(ICOUT,2150)(IANS(I),I=1,MIN(IWIDTH,80))
 2150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
C
C               *******************************************************
C               **  STEP 21B--                                       **
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='21B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.EQ.'V' .AND. N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2161)
 2161   FORMAT('***** ERROR IN THE COCHRAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2162)
 2162   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2163)
 2163   FORMAT('      OF THE COCHRAN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2165)
 2165   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2166)N1,N2
 2166   FORMAT('      N1 = ',I8,' N2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2169)
 2169   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2170)(IANS(I),I=1,MIN(IWIDTH,80))
 2170     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ****************************************
C               **  STEP 22--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,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,2241)
 2241    FORMAT('***** ERROR IN THE COCHRAN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2242)
 2242    FORMAT('      FOR THE COCHRAN TEST, THE THIRD ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2245)
 2245    FORMAT('      SECOND FACTOR (= TREATMENT) VARIABLE)  MUST BE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2246)
 2246    FORMAT('      A VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2247)
 2247    FORMAT('      FUNCTION).  ARGUMENT 3 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2248)
 2248    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,2250)(IANS(I),I=1,MIN(IWIDTH,80))
 2250      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE3=IUSE(ILOCV)
      ICOL3=IVALUE(ILOCV)
      N3=IN(ILOCV)
C
C               *******************************************************
C               **  STEP 21B--                                       **
C               **  IF ARGUMENT 3 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N3) **
C               **  FOR ARGUMENT 3 IS THE SAME AS ARGUMENT 1.        **
C               *******************************************************
C
      ISTEPN='22B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE3.EQ.'V' .AND. N1.NE.N3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2261)
 2261   FORMAT('***** ERROR IN THE COCHRAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2262)
 2262   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 3')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2263)
 2263   FORMAT('      OF THE COCHRAN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2265)
 2265   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2266)N1,N3
 2266   FORMAT('      N1 = ',I8,' N3 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2269)
 2269   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2270)(IANS(I),I=1,MIN(IWIDTH,80))
 2270     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')THEN
        WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
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' .OR. ISUBRO.EQ.'COCH')
     1CALL 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
      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.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4151)
 4151   FORMAT('***** ERROR IN THE COCHRAN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4152)
 4152   FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN EXTRACTED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4153)IH11,IH12
 4153   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING FROM ',
     1         'VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4154)
 4154   FORMAT('      (FOR WHICH THE FRIEDMAN TEST IS TO BE CARRIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4156)MINN2
 4156   FORMAT('      OUT) 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(IWIDTH,80))
 4159     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      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
        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
        IJ=MAXN*(ICOL3-1)+I
        IF(ICOL2.LE.MAXCOL)XTEMP2(J)=V(IJ)
        IF(ICOL2.EQ.MAXCP1)XTEMP2(J)=PRED(I)
        IF(ICOL2.EQ.MAXCP2)XTEMP2(J)=RES(I)
        IF(ICOL2.EQ.MAXCP3)XTEMP2(J)=YPLOT(I)
        IF(ICOL2.EQ.MAXCP4)XTEMP2(J)=XPLOT(I)
        IF(ICOL2.EQ.MAXCP5)XTEMP2(J)=X2PLOT(I)
        IF(ICOL2.EQ.MAXCP6)XTEMP2(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
C               **********************************
C               **  STEP 3---                   **
C               **  CARRY OUT THE COCHRAN TEST  **
C               **********************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'COCH')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5211)
 5211   FORMAT('***** FROM DPCOCH, AS WE ARE ABOUT TO CALL DPCOC2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5212)N1,NS1
 5212   FORMAT('N1,NS1 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO5215I=1,NS1
          WRITE(ICOUT,5216)I,Y(I),X(I),XTEMP2(I)
 5216     FORMAT('I,Y(I),X(I),XTEMP2(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
 5215   CONTINUE
        WRITE(ICOUT,5231)IBUGA3
 5231   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPCOC2(Y,X,XTEMP2,NS1,
     1Z,XTEMP1,XTEMP3,XTEMP4,XTEMP5,
     1MAXNXT,MAXCOC,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'COCH')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPCO'
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.'ON' .OR. ISUBRO.EQ.'COCH')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPCOCH--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3,IBUGQ
 9012   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)NLOCAL,NS1
 9014   FORMAT('NLOCAL,NS1 = ',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 ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCOC2(Y,BLOCK,TREAT,N,
     1Z,C,R,TEMP1,TEMP2,
     1MAXNXT,MAXCOC,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT COCHRAN'S TEST
C              ANALYSIS OF A RANDOMIZED COMPLETE BLOCK DESIGN
C              WHERE THE OUTCOME CAN BE EITHER "SUCCESS" OR
C              "FAILURE" (OR ANY TWO MUTUALLY EXCLUSIVE OUTCOMES).
C              THESE ARE CODED AS ZERO AND ONE.
C              IN DATAPLOT, THE COLUMNS REPRESENT TREATMENTS AND
C              THE ROWS REPRESENT SUBJECTS.
C
C              THE TEST STATISTIC IS:
C
C                 T = c*(c-1)*SUM[J=1 to c][(C(j) - N/c)**2]/
C                     SUM[i=1 to r][R(i)*(c - R(i))]
C
C              WITH c, r, C(j), R(i) AND N denoting the
C              NUMBER OF COLUMNS, NUMBER OF ROWS, COLUMN TOTALS,
C              ROW TOTALS, AND GRAND TOTAL RESPECTIVELY.
C
C              THE CRITICAL VALUE IS:
C
C                 CHSPPF(c-1,ALPHA)
C
C     EXAMPLE--COCHRAN TEST Y X1 X2
C     REFERENCE--W. J., CONOVER, 1999, "PRACTICAL NON-PARAMETRIC
C                STATSTICS", THIRD EDITION, WILEY, PP. 251-256.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/10
C     ORIGINAL VERSION--OCTOBER   2004.
C     UPDATED         --DECEMBER  2005. RECODE TO USE
C                                         COCHRAN TEST Y X1 X2
C                                       INSTEAD OF
C                                         COCHRAN TEST Y X1 ... XK
C                                       IN ORDER TO BE CONSISTENT
C                                       WITH OTHER DATAPLOT COMMANDS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
      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 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*3 IATEMP
C
      DOUBLE PRECISION DSUM1
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION BLOCK(*)
      DIMENSION TREAT(*)
      DIMENSION C(*)
      DIMENSION R(*)
      DIMENSION TEMP1(*)
      DIMENSION TEMP2(*)
      DIMENSION Z(MAXNXT,MAXCOC)
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='DPCO'
      ISUBN2='C2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'COC2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPCOC2--')
        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),BLOCK(I),TREAT(I)
   57     FORMAT('I,Y(I),BLOCK(I),TREAT(I) = ',I8,3F10.2)
          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.'COC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ALOW=Y(1)
      AHIGH=CPUMAX
      IDIST=1
C
      DO110I=1,N
        ATEMP=Y(I)
        IF(IDIST.EQ.1)THEN
          IF(ATEMP.EQ.ALOW)THEN
            GOTO110
          ELSE
            IDIST=IDIST+1
            AHIGH=ATEMP
            GOTO110
          ENDIF
        ELSEIF(IDIST.EQ.2)THEN
          IF(ATEMP.EQ.ALOW .OR. ATEMP.EQ.AHIGH)THEN
            GOTO110
          ELSE
            IDIST=IDIST+1
            GOTO129
          ENDIF
        ELSE
          GOTO129
        ENDIF
  110 CONTINUE
C
  129 CONTINUE
C
      IF(IDIST.GT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,161)
  161   FORMAT('***** ERROR FROM COCHRAN TEST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,163)
  163   FORMAT('      MORE THAN TWO DISTINCT VALUES DETECTED IN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,165)
  165   FORMAT('      INPUT DATA.  THE COCHRAN TEST IS FOR')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,167)
  167   FORMAT('      DICHOTOMOUS DATA.  NOTHING DONE.')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(ALOW.GT.AHIGH)THEN
        ATEMP=ALOW
        ALOW=AHIGH
        AHIGH=ATEMP
      ENDIF
C
      DO220I=1,N
        IF(Y(I).EQ.ALOW)Y(I)=0.0
        IF(Y(I).EQ.AHIGH)Y(I)=1.0
  220 CONTINUE
C
C               ******************************************
C               **  STEP 31--                          **
C               **  COMPUTE DISTINCT ROWS AND COLUMNS. **
C               **  INITIALIZE Z MATRIX TO -99 SO WE   **
C               **  CAN DETECT EMPTY CELLS (COCHRAN    **
C               **  TEST ASSUMES COMPLETE BLOCKS)      **
C               *****************************************
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'COC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL CODE(BLOCK,N,IWRITE,TEMP1,IBUGA3,IERROR)
      DO301I=1,N
        BLOCK(I)=TEMP1(I)
  301 CONTINUE
      CALL MAXIM(BLOCK,N,IWRITE,XMAX,IBUGA3,IERROR)
      NROW=INT(XMAX+0.5)
C
      CALL CODE(TREAT,N,IWRITE,TEMP1,IBUGA3,IERROR)
      DO303I=1,N
        TREAT(I)=TEMP1(I)
  303 CONTINUE
      CALL MAXIM(TREAT,N,IWRITE,XMAX,IBUGA3,IERROR)
      NCOL=INT(XMAX+0.5)
C
      DO310J=1,NCOL
        DO320I=1,NROW
          Z(I,J)=-99.0
  320   CONTINUE
  310 CONTINUE
C
      DO330I=1,N
        IROW=INT(BLOCK(I)+0.5)
        ICOL=INT(TREAT(I)+0.5)
        Z(IROW,ICOL)=Y(I)
  330 CONTINUE
C
      DO340J=1,NCOL
        DO350I=1,NROW
          IF(Z(I,J).LT.-0.5)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,361)
  361       FORMAT('***** ERROR FROM COCHRAN TEST--')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,363)
  363       FORMAT('      AN INCOMPLETE BLOCK DESIGN WAS DETECTED.')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,365)IROW,ICOL
  365       FORMAT('      ROW ',I8,' AND COLUMM ',I8,' WAS EMPTY.')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
  350   CONTINUE
  340 CONTINUE
      IF(NROW*NCOL.NE.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,361)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,363)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,367)NROW,NCOL
  367   FORMAT('      THE NUMBER OF ROWS (',I8,') TIMES THE ',
     1         'NUMBER OF COLUMMS ( ',I8,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,369)N
  369   FORMAT('      DOES NOT EQUAL THE SAMPLE SIZE (',I8,').')
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR COCHRAN TEST        **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'COC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
C  STEP 1: COMPUTE ROW AND COLUMN TOTALS
C
      AN=0.0
      DO410J=1,NCOL
        SUM1=0.0
        DO420I=1,NROW
          SUM1=SUM1 + Z(I,J)
  420   CONTINUE
        C(J)=SUM1
        AN=AN + SUM1
  410 CONTINUE
C
      DO460I=1,NROW
        SUM1=0.0
        DO470J=1,NCOL
          SUM1=SUM1 + Z(I,J)
  470   CONTINUE
        R(I)=SUM1
  460 CONTINUE
C
C  STEP 2: COMPUTE TEST STATISTIC
C
      ANCOL=REAL(NCOL)
      ANROW=REAL(NROW)
C
      ANUM=0.0
      DO510J=1,NCOL
        ANUM=ANUM + (C(J) - AN/ANCOL)**2
  510 CONTINUE
C
      ADEN=0.0
      DO520I=1,NROW
        ADEN=ADEN + R(I)*(ANCOL - R(I))
  520 CONTINUE
C
      STATVA=ANCOL*(ANCOL-1.0)*ANUM/ADEN
 
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'COC2')THEN
        WRITE(ICOUT,531)ANUM,ADEN,STATVA
  531   FORMAT('ANUM,ADEN,STATVA = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        DO541J=1,NCOL
          WRITE(ICOUT,543)J,C(J)
  543     FORMAT('J,C(J) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
  541   CONTINUE
        DO551I=1,NROW
          WRITE(ICOUT,553)I,R(I)
  553     FORMAT('I,R(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
  551   CONTINUE
      ENDIF
C
      NUMDF1=NCOL-1
      CALL CHSCDF(STATVA,NUMDF1,STATCD)
C
      CUT0=0.0
      CALL CHSPPF(.50,NUMDF1,CUT50)
      CALL CHSPPF(.75,NUMDF1,CUT75)
      CALL CHSPPF(.90,NUMDF1,CUT90)
      CALL CHSPPF(.95,NUMDF1,CUT95)
      CALL CHSPPF(.99,NUMDF1,CUT99)
      CALL CHSPPF(.999,NUMDF1,CUT999)
C
      ICONC1='ACCEPT'
      ICONC2='ACCEPT'
      ICONC3='ACCEPT'
C
      IF(STATVA.GT.CUT95)ICONC2='REJECT'
C
C               ******************************
C               **   STEP 43--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR COCHRAN  TEST      **
C               ******************************
C
      ISTEPN='43'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'COC2')
     1CALL 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('COCHRAN NON-PARAMETRIC TEST FOR RANDOMIZED ',
     1         'COMPLETE BLOCK DESIGN
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55003)
55003   FORMAT('FOR DICHOTOMOUS DATA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
 5004   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START LIST
C
        WRITE(ICOUT,5005)
 5005   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2A: LIST ITEM 1
C
        WRITE(ICOUT,5006)
 5006   FORMAT('   
  1. Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
 5007   FORMAT('       
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
 5011   FORMAT('       ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
 5021   FORMAT('         ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
 5023   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
 5026   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5042)
 5042   FORMAT('               Number of Treatments:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NCOL
        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,5043)
 5043   FORMAT('               Cochran Test Statstic:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)STATVA
 5051   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
 5091   FORMAT('       
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
 5025   FORMAT('               Number of Subjects (Rows):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
 5027   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NROW
 5029   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
 5028   FORMAT('         
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: LIST ITEM 2
C
        WRITE(ICOUT,5066)
 5066   FORMAT('   
  2. Percent Points of the Chi-Square Reference ',
     1         'Distribution
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
 5067   FORMAT('       for Cochran Test Statistic:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
 5071   FORMAT('               0    Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
 5072   FORMAT('               50   Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
 5073   FORMAT('               75   Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
 5074   FORMAT('               90   Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
 5075   FORMAT('               95   Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
 5076   FORMAT('               99   Percent Point:')
        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
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
 5077   FORMAT('               99.5 Percent Point:')
        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,5078)100.0*STATCD
 5078   FORMAT('
                   ',G15.7,' Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)STATVA
 5052   FORMAT('
                ',G15.7)
        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,5007)
        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,5007)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,5087)NCOL
 5087     FORMAT('        The ',I8,' treatments have equal ',
     1           'effects.')
        ELSE
          WRITE(ICOUT,5088)NCOL
 5088     FORMAT('        The ',I8,' treatments do not have ',
     1           'equal effects.')
        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
 8001   FORMAT('{',A1,'bf COCHRAN NON-PARAMETRIC TEST FOR RANDOMIZED ',
     1         'COMPLETE BLOCK DESIGNS FOR DICHOTOMOUS DATA}')
 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,8001)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,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 Chi-Square Reference',
     1         ' Distribution:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Subjects (Rows): & ',I8,2X,A1,A1)
 8033   FORMAT(11X,'Number of Treatments: & ',I8,2X,A1,A1)
 8034   FORMAT(11X,'Cochran Test Statistic: & ',G15.7,
     1         2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8041   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'The ',I8,' treatments have equal effects.',
     1         2X,A1,A1)
 8043   FORMAT(11X,'The ',I8,' treatments do not have equal ',
     1         'effects.',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.5   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)NROW,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)NCOL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)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,8041)100.*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)NCOL,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)NCOL,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('    COCHRAN NON-PARAMETRIC TEST FOR ',
     1        'RANDOMIZED COMPLETE BLOCK DESIGN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7213)
 7213   FORMAT('    FOR DICHOTOMOUS DATA ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7220)
 7220   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7221)NROW
 7221   FORMAT(6X,'NUMBER OF SUBJECTS (ROWS)           = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7222)NCOL
 7222   FORMAT(6X,'NUMBER OF TREATMENTS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)STATVA
 7224   FORMAT(6X,'COCHRAN TEST STATISTIC             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
 7240   FORMAT('2. PERCENT POINTS OF THE LARGE SAMPLE CHI-SQUARE ',
     1         'REFERENCE DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR COCHRAN TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7265)CUT0
 7265   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7266)CUT50
 7266   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7267)CUT75
 7267   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7268)CUT90
 7268   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7269)CUT95
 7269   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7270)CUT99
 7270   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7271)CUT999
 7271   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,7280)100.*STATCD,STATVA
 7280   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7291)
 7291   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7293)NCOL
 7293     FORMAT(6X,'THE ',I8,' TREATMENTS HAVE EQUAL EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7295)NCOL
 7295     FORMAT(6X,'THE ',I8,' TREATMENTS DO NOT HAVE EQUAL ',
     1           'EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'COC2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPCOC2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)NROW,NCOL,IBUGA3,IERROR
 9012   FORMAT('NROW,NCOL,IBUGA3,IERROR = ',2I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCOD2(IDIG,IHDIG,IBUGD3,IERROR)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPCODH.
C           IT HAS BEEN DUPLICATED AND PLACED
C           ON THIS BRANCH OF THE OVERLAY/SEGMENTATION
C           TREE STRUCTURE IN ORDER TO ACHIEVE
C           FASTER EXECUTION TIME.
C
C     PURPOSE--CONVERT NUMERIC DIGIT INTO CORRESPONDING
C              CHARACTER.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MARCH   1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHDIG
      CHARACTER*4 IBUGD3
      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
      IHDIG='-999'
      IF(IDIG.EQ.1)IHDIG='1'
      IF(IDIG.EQ.2)IHDIG='2'
      IF(IDIG.EQ.3)IHDIG='3'
      IF(IDIG.EQ.4)IHDIG='4'
      IF(IDIG.EQ.5)IHDIG='5'
      IF(IDIG.EQ.6)IHDIG='6'
      IF(IDIG.EQ.7)IHDIG='7'
      IF(IDIG.EQ.8)IHDIG='8'
      IF(IDIG.EQ.9)IHDIG='9'
      IF(IDIG.EQ.0)IHDIG='0'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPCOD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IDIG,IHDIG
 9012 FORMAT('IDIG,IHDIG = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD3,IERROR
 9013 FORMAT('IBUGD3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCODH(IDIG,IHDIG,IBUGD3,IERROR)
C
C     PURPOSE--CONVERT NUMERIC DIGIT INTO CORRESPONDING
C              CHARACTER.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MARCH   1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHDIG
      CHARACTER*4 IBUGD3
      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
      IHDIG='-999'
      IF(IDIG.EQ.1)IHDIG='1'
      IF(IDIG.EQ.2)IHDIG='2'
      IF(IDIG.EQ.3)IHDIG='3'
      IF(IDIG.EQ.4)IHDIG='4'
      IF(IDIG.EQ.5)IHDIG='5'
      IF(IDIG.EQ.6)IHDIG='6'
      IF(IDIG.EQ.7)IHDIG='7'
      IF(IDIG.EQ.8)IHDIG='8'
      IF(IDIG.EQ.9)IHDIG='9'
      IF(IDIG.EQ.0)IHDIG='0'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END OF DPCODH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IDIG,IHDIG
 9012 FORMAT('IDIG,IHDIG = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD3,IERROR
 9013 FORMAT('IBUGD3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCODS(ICASE,D,P,IBUGD2,ISUBRO,IERROR)
C
C     PURPOSE--CONVERT AN INPUT X OR Y VALUE (IN DATA UNITS)
C              (RELATIVE TO THE LAST PLOT THAT APPEARED)
C              INTO ABSOLUTE (0. TO 100.) X OR Y SCREEN UNITS.
C     NOTE--CHARACTER*1 ICASE WILL BE EITHER 'X' OR 'Y'
C     ORIGINAL VERSION--NOVEMBER 1992
C     UPDATED         --MARCH    2001  SUPPORT FOR LOG SCALES (BUT NOT
C                                      WEIBULL AND NORMAL)
C                                     
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*1 ICASE
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.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
      IERROR='NO'
C
      IF(IBUGD2.NE.'ON'.AND.ISUBRO.NE.'CODS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCODS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGD2,ISUBRO,IERROR
   53 FORMAT('IBUGD2,ISUBRO,IERROR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ICASE,D,P
   54 FORMAT('ICASE,D,P = ',A1,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)PXMIN,PXMAX,PYMIN,PYMAX
   61 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)FX1MIN,FX2MAX,FY1MIN,FY2MAX
   62 FORMAT('FX1MIN,FX2MAX,FY1MIN,FY2MAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IX1TSC,IY1TSC
   64 FORMAT('IX1TSC,IY1TSC = ',2(A4,2X))
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(ICASE.EQ.'X')THEN
        IF(IX1TSC.EQ.'LOG')THEN
          IF(FX1MIN.LE.0.0 .OR. D.LE.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,121)
  121 FORMAT('***** FROM DPCODS: NEGATIVE NUMBER ENCOUNTERED FOR')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,123)
  123 FORMAT('      EITHER THE AXIS MINIMUM OR THE X COORDINATE')
            CALL DPWRST('XXX','BUG ')
            XFRACT=(D-FX1MIN)/(FX1MAX-FX1MIN)
            P=PXMIN+XFRACT*(PXMAX-PXMIN)
            GOTO299
          ENDIF
          ARG1=ALOG10(FX1MIN)
          ARG2=ALOG10(FX1MAX)
          ARG3=ALOG10(D)
          XFRACT=(ARG3-ARG1)/(ARG2-ARG1)
          P=PXMIN+XFRACT*(PXMAX-PXMIN)
        ELSEIF(IX1TSC.EQ.'WEIB')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,111)
  111 FORMAT('***** FROM DPCODS: WEIBULL SCALE NOT SUPPORTED FOR ',
     1       'X AXIS')
          XFRACT=(D-FX1MIN)/(FX2MAX-FX1MIN)
          P=PXMIN+XFRACT*(PXMAX-PXMIN)
        ELSEIF(IX1TSC.EQ.'NORM')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,101)
  101 FORMAT('***** FROM DPCODS: NORMAL SCALE NOT SUPPORTED FOR ',
     1       'X AXIS')
          CALL DPWRST('XXX','BUG ')
          XFRACT=(D-FX1MIN)/(FX2MAX-FX1MIN)
          P=PXMIN+XFRACT*(PXMAX-PXMIN)
        ELSE
          XFRACT=(D-FX1MIN)/(FX2MAX-FX1MIN)
          P=PXMIN+XFRACT*(PXMAX-PXMIN)
        ENDIF
      ELSE
        IF(IY1TSC.EQ.'LOG')THEN
          IF(FY1MIN.LE.0.0 .OR. D.LE.0.0)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,221)
  221 FORMAT('***** FROM DPCODS: NEGATIVE NUMBER ENCOUNTERED FOR')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,223)
  223 FORMAT('      EITHER THE AXIS MINIMUM OR THE Y COORDINATE')
            CALL DPWRST('XXX','BUG ')
            YFRACT=(D-FY1MIN)/(FY1MAX-FY1MIN)
            P=PYMIN+YFRACT*(PYMAX-PYMIN)
            GOTO299
          ENDIF
          ARG1=ALOG10(FY1MIN)
          ARG2=ALOG10(FY1MAX)
          ARG3=ALOG10(D)
          YFRACT=(ARG3-ARG1)/(ARG2-ARG1)
          P=PYMIN+YFRACT*(PYMAX-PYMIN)
        ELSEIF(IY1TSC.EQ.'WEIB')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,211)
  211 FORMAT('***** FROM DPCODS: WEIBULL SCALE NOT SUPPORTED FOR ',
     1       'Y AXIS')
          YFRACT=(D-FY1MIN)/(FY2MAX-FY1MIN)
          P=PYMIN+YFRACT*(PYMAX-PYMIN)
        ELSEIF(IY1TSC.EQ.'NORM')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,201)
  201 FORMAT('***** FROM DPCODS: NORMAL SCALE NOT SUPPORTED FOR ',
     1       'Y AXIS')
          YFRACT=(D-FY1MIN)/(FY1MAX-FY1MIN)
          P=PYMIN+YFRACT*(PYMAX-PYMIN)
        ELSE
          YFRACT=(D-FY1MIN)/(FY1MAX-FY1MIN)
          P=PYMIN+YFRACT*(PYMAX-PYMIN)
        ENDIF
      ENDIF
  299 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGD2.NE.'ON'.AND.ISUBRO.NE.'CODS')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE BEGINNING OF DPCODS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD2,ISUBRO,IERROR
 9013 FORMAT('IBUGD2,ISUBRO,IERROR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASE,D,P
 9014 FORMAT('ICASE,D,P = ',A1,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)PXMIN,PXMAX,PYMIN,PYMAX
 9021 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)FX1MIN,FX2MAX,FY1MIN,FY2MAX
 9022 FORMAT('FX1MIN,FX2MAX,FY1MIN,FY2MAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOFH(IL1,IL2,IFUNC,NUMCHF,IH,NH,IBUGD2,IERROR)
C
C     PURPOSE--COPY OVER THE FUNCTION STRING IN LOCATIONS
C              IL1 TO IL2 OF IFUNC(.) AND PLACE IT IN
C              LOCATIONS 1 TO NH (= ILOC2-ILOC1+1)
C              OF THE ARRAY IH(.)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/7
C     ORIGINAL VERSION--JUNE  1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFUNC
      CHARACTER*4 IH
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      DIMENSION IFUNC(*)
      DIMENSION IH(*)
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
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='DPCO'
      ISUBN2='FH  '
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 DPCOFH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IL1,IL2
   52 FORMAT('IL1,IL2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMCHF
   54 FORMAT('NUMCHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      IMAX=NUMCHF
      IF(IMAX.GT.100)IMAX=100
      WRITE(ICOUT,55)(IFUNC(I),I=1,IMAX)
   55 FORMAT('IFUNC(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 11--                  **
C               **  COPY OVER THE STRING       **
C               *********************************
      J=0
      IF(IL1.GT.IL2)GOTO1150
      DO1100I=IL1,IL2
      J=J+1
      IH(J)=IFUNC(I)
 1100 CONTINUE
 1150 CONTINUE
      NH=J
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 DPCOFH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IL1,IL2
 9012 FORMAT('IL1,IL2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMCHF
 9014 FORMAT('NUMCHF = ',I8)
      CALL DPWRST('XXX','BUG ')
      IMAX=NUMCHF
      IF(IMAX.GT.100)IMAX=100
      WRITE(ICOUT,9015)(IFUNC(I),I=1,IMAX)
 9015 FORMAT('IFUNC(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)NH
 9024 FORMAT('NH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IMAX=NH
      IF(IMAX.GT.100)IMAX=100
      WRITE(ICOUT,9025)(IH(I),I=1,IMAX)
 9025 FORMAT('IH(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOFI(ICOM,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COPY AN INPUT FILE TO AN OUTPUT FILE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/1
C     ORIGINAL VERSION--MAY       1994.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
C
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IANSI
      CHARACTER*80 ICANS
      CHARACTER*80 ISTRIN
CCCCC CHARACTER*40 ICJUNK
C
      DIMENSION IANSLC(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.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='DPCO'
      ISUBN2='FI  '
C
      IFOUND='YES'
      IERROR='NO'
C
      MINN2=1
      NCSTRI=(-999)
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'COFI')GOTO100
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICOM
   52 FORMAT('ICOM = ',A4)
      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)ILISNU
   61 FORMAT('ILISNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ILISNA
   62 FORMAT('ILISNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ILISST
   63 FORMAT('ILISST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ILISFO
   64 FORMAT('ILISFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ILISAC
   65 FORMAT('ILISAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ILISFO
   66 FORMAT('ILISFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ILISCS
   67 FORMAT('ILISCS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ICONNU
   71 FORMAT('ICONNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICONNA
   72 FORMAT('ICONNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ICONST
   73 FORMAT('ICONST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ICONFO
   74 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ICONAC
   75 FORMAT('ICONAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ICONFO
   76 FORMAT('ICONFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ICONCS
   77 FORMAT('ICONCS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IDIRNU
   81 FORMAT('IDIRNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IDIRNA
   82 FORMAT('IDIRNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDIRST
   83 FORMAT('IDIRST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDIRFO
   84 FORMAT('IDIRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IDIRAC
   85 FORMAT('IDIRAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IDIRFO
   86 FORMAT('IDIRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IDIRCS
   87 FORMAT('IDIRCS = ',A12)
      CALL DPWRST('XXX','BUG ')
  100 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=ILISNU
      IFILE1=ILISNA
      ISTAT1=ILISST
      IFORM1=ILISFO
      IACCE1=ILISAC
      IPROT1=ILISPR
      ICURS1=ILISCS
C
      IOUNI2=IWRINU
      IFILE2=IWRINA
      ISTAT2=IWRIST
      IFORM2=IWRIFO
      IACCE2=IWRIAC
      IPROT2=IWRIPR
      ICURS2=IWRICS
C
      ISUBN0='COFI'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'COFI')GOTO1199
      WRITE(ICOUT,1181)IOUNI1
 1181 FORMAT('IOUNI1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IFILE1
 1182 FORMAT('IFILE1 = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2
 1183 FORMAT('ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2 = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,1191)IOUNI2
 1191 FORMAT('IOUNI2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1192)IFILE2
 1192 FORMAT('IFILE2 = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1193)ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1
 1193 FORMAT('ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1 = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,1198)ISUBN0,IERRFI
 1198 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  CHECK TO SEE IF THE COPY FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 1994.
CCCCC IF(ISTAT.EQ.'NONE')GOTO1200
      IF(ISTAT1.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPCOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED LISTING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE INTERNAL VARIABLE    ILISST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH ALLOWS SUCH LISTING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT1,ILISST
 1217 FORMAT('ISTAT1,ILISST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  EXTRACT THE INPUT  FILE NAME.    **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     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,IFILE1,NCFIL1,
     1IBUGS2,ISUBRO,IERROR)
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=3
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFILE2,NCFIL2,
     1IBUGS2,ISUBRO,IERROR)
C
 1370 CONTINUE
      IF(NCFIL1.GE.1.AND.NCFIL2.GE.1)GOTO1390
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1371)
 1371 FORMAT('***** ERROR IN DPCOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1372)
 1372 FORMAT('      2 FILE NAMES--AN INPUT AND AN OUTPUT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1373)
 1373 FORMAT('      ARE REQUIRED IN THE COPY COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1374)
 1374 FORMAT('      (FOR EXAMPLE,    COPY BOXSPRIN.DAT TEMP.)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1375)
 1375 FORMAT('      BUT 2 NAMES WERE NOT GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
C
      IF(NCFIL1.GE.1)THEN
         WRITE(ICOUT,1381)(IFILE1(I:I),I=1,NCFIL1)
 1381    FORMAT('   INPUT  FILE--',80A1)
         CALL DPWRST('XXX','BUG ')
      ELSE
         WRITE(ICOUT,1382)
 1382    FORMAT('   INPUT  FILE--')
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(NCFIL2.GE.1)THEN
         WRITE(ICOUT,1383)(IFILE2(I:I),I=1,NCFIL2)
 1383    FORMAT('   OUTPUT FILE--',80A1)
         CALL DPWRST('XXX','BUG ')
      ELSE
         WRITE(ICOUT,1384)
 1384    FORMAT('   OUTPUT FILE--')
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      WRITE(ICOUT,1386)
 1386 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
         WRITE(ICOUT,1387)(IANSLC(I),I=1,IWIDTH)
 1387    FORMAT('      ',80A1)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1390 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'COFI')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               *********************************************
C               **  STEP 22--                              **
C               **  BRANCH    TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2210
      IF(ICASEQ.EQ.'SUBS')GOTO2220
      IF(ICASEQ.EQ.'FOR')GOTO2230
C
 2210 CONTINUE
      DO2215I=1,MAXN
      ISUB(I)=1
 2215 CONTINUE
      NQ=MAXN
      GOTO2270
C
 2220 CONTINUE
      NIOLD=MAXN
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2270
C
 2230 CONTINUE
      NIOLD=MAXN
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      NMXFOR=IROWN
      GOTO2270
C
 2270 CONTINUE
      IF(NQ.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2271)
 2271 FORMAT('***** ERROR IN DPCOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2272)
 2272 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2273)
 2273 FORMAT('      THE NUMBER OF SPECIFIED FILE LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2274)
 2274 FORMAT('      TO BE LISTED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2276)MINN2
 2276 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2277)
 2277 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2278)
 2278 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2279)(IANSLC(I),I=1,IWIDTH)
 2279 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
      NS=NQ
C
C               ****************************************
C               **  STEP 51--                         **
C               **  OPEN  THE INPUT AND OUTPUT FILES  **
C               **  (UNLESS ITS THE                   **
C               **  CONCLUSIONS FILE).                **
C               ****************************************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')THEN
         WRITE(ICOUT,3111)IFILE1
 3111    FORMAT('IFILE1 = ',A80)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,3112)IFILE2
 3112    FORMAT('IFILE2 = ',A80)
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IFILE2.EQ.ICONNA)GOTO3190
C
      IREWIN='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 3190 CONTINUE
C
C               ***********************************
C               **  STEP 41--                    **
C               **  READ IN THE INPUT FILE.      **
C               **  WRITE OUT THE OUTPUT FILE.   **
C               ***********************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAX=1000000
      IF(ICASEQ.EQ.'SUBS')IMAX=MAXN
      IF(ICASEQ.EQ.'FOR')IMAX=IROWN
C
      DO4110I=1,IMAX
C
      READ(IOUNI1,4111,END=4190)(ISTRIN(J:J),J=1,80)
 4111 FORMAT(80A1)
 
      IF(ISUB(I).EQ.1)THEN
         CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
         NCSTRI=JMAX
         WRITE(IOUNI2,4112)(ISTRIN(J:J),J=1,80)
 4112    FORMAT(80A1)
      ENDIF
C
 4110 CONTINUE
 4190 CONTINUE
C
C               **************************
C               **  STEP 51--           **
C               **  CLOSE THE 2 FILES   **
C               **  (UNLESS ITS THE     **
C               **  CONCLUSIONS FILE).  **
C               **************************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'COFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFILE2.EQ.ICONNA)GOTO5190
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
 5190 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'COFI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOFI--')
      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,9013)ICOM
 9013 FORMAT('ICOM = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNI1,IOUNI2
 9021 FORMAT('IOUNI1,IOUNI2 = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE1
 9022 FORMAT('IFILE1  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IFILE2
 9023 FORMAT('IFILE2  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ISTAT1,ISTAT2
 9024 FORMAT('ISTAT1,ISTAT2  = ',A12,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFORM1,IFORM2
 9025 FORMAT('IFORM1,IFORM2  = ',A12,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IACCE1,IACCE2
 9026 FORMAT('IACCE1,IACCE2 = ',A12,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IPROT1,IPROT2
 9027 FORMAT('IPROT1,IPROT2  = ',A12,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)ICURS1,ICURS2
 9028 FORMAT('ICURS1,ICURS2 = ',A12,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IENDFI
 9029 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)IREWIN
 9030 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)ICASEQ,NQ,NS
 9041 FORMAT('ICASEQ,NQ,NS = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)JMAX,NCSTRI
 9042 FORMAT('JMAX,NCSTRI = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOHI(ISTART,ISTOP,IANS2,N2,IVALID,VALCON,IVALCO,
     1IBUGA3,IERROR)
C
C     PURPOSE--DETERMINE IF THE STRING DEFINED
C              IN LOCATIONS ISTART THROUGH ISTOP (INCLUSIVE) IN IANS2(.).
C              IS A VALID NUMBER REPRESENTATION
C              AND IF SO, COMPUTE THE VALUE OF THE NUMBER.
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPHOCO EXCEPT
C           FOR THE FACT THAT DPHOCO HAS THE INPUT STRING
C           IN LOCATIONS 1 THROUGH N2 OF IANS2(.)
C           WHEREAS DPCOHI HAS THE INPUT STRING
C           IN LOCATIONS ISTART THROUGH ISTOP OF IANS(.).
C
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --NOVEMBER  1989.  ITYPE2='NUMBER' BUG
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IANS2
      CHARACTER*4 IVALID
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ITYPE2
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IANS2(*)
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='DPCO'
      ISUBN2='HI  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)
   81 FORMAT('***** AT THE BEGINNING OF DPCOHI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)N2,ISTART,ISTOP
   82 FORMAT('N2,ISTART,ISTOP = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)(IANS2(I),I=1,N2)
   83 FORMAT('IANS2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVALID='NO'
C
C               ********************************************************
C               **  STEP 7--                                          **
C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING  **
C               **  POINT ARGUMENT.                                   **
C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.        **
C               ********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AMIN=-1000000.
      AMAX=+1000000.
      IERROR='NO'
      IVALID='YES'
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1989
CCCCC ITYPE2='NUMBER'
      ITYPE2='NUMB'
      VALCON=-999.0
      IVALCO=-999
C
      ISTAR2=ISTART
      ISTOP2=ISTOP
C
      ILOC=0
      IDECPT=0
      DO3060I=ISTAR2,ISTOP2
      IF(IANS2(I).EQ.'.')ILOC=I
      IF(IANS2(I).EQ.'.')IDECPT=IDECPT+1
 3060 CONTINUE
      IF(IDECPT.GE.2)GOTO3900
      IF(IDECPT.EQ.1)GOTO3150
      DO3100I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS2(IREV).EQ.' ')GOTO3100
      IF(IANS2(IREV).EQ.'0')GOTO3110
      IF(IANS2(IREV).EQ.'1')GOTO3110
      IF(IANS2(IREV).EQ.'2')GOTO3110
      IF(IANS2(IREV).EQ.'3')GOTO3110
      IF(IANS2(IREV).EQ.'4')GOTO3110
      IF(IANS2(IREV).EQ.'5')GOTO3110
      IF(IANS2(IREV).EQ.'6')GOTO3110
      IF(IANS2(IREV).EQ.'7')GOTO3110
      IF(IANS2(IREV).EQ.'8')GOTO3110
      IF(IANS2(IREV).EQ.'9')GOTO3110
      IERROR='YES'
      IF(IANS2(IREV).EQ.'+')GOTO3900
      IF(IANS2(IREV).EQ.'-')GOTO3900
      GOTO3900
 3100 CONTINUE
      IERROR='YES'
      GOTO3900
 3110 ILOC=IREV+1
 3150 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
C
      SIGN=1.0
      IDIGI=0
      ISIGN=0
      SUMI=0
      ILOCM1=ILOC-1
      IF(ILOCM1.LT.ISTAR2)GOTO3250
      DO3200I=ISTAR2,ILOCM1
      IREV=ILOCM1-(I-ISTAR2)
      IF(IANS2(IREV).EQ.' ')GOTO3200
      IF(IANS2(IREV).EQ.'0')GOTO3210
      IF(IANS2(IREV).EQ.'1')GOTO3211
      IF(IANS2(IREV).EQ.'2')GOTO3232
      IF(IANS2(IREV).EQ.'3')GOTO3213
      IF(IANS2(IREV).EQ.'4')GOTO3214
      IF(IANS2(IREV).EQ.'5')GOTO3215
      IF(IANS2(IREV).EQ.'6')GOTO3216
      IF(IANS2(IREV).EQ.'7')GOTO3217
      IF(IANS2(IREV).EQ.'8')GOTO3218
      IF(IANS2(IREV).EQ.'9')GOTO3219
      IF(IANS2(IREV).EQ.'+')GOTO3220
      IF(IANS2(IREV).EQ.'-')GOTO3221
      IERROR='YES'
      GOTO3900
 3210 ITERM=0
      GOTO3225
 3211 ITERM=1
      GOTO3225
 3232 ITERM=2
      GOTO3225
 3213 ITERM=3
      GOTO3225
 3214 ITERM=4
      GOTO3225
 3215 ITERM=5
      GOTO3225
 3216 ITERM=6
      GOTO3225
 3217 ITERM=7
      GOTO3225
 3218 ITERM=8
      GOTO3225
 3219 ITERM=9
      GOTO3225
 3220 ISIGN=ISIGN+1
      GOTO3200
 3221 ISIGN=ISIGN+1
      SIGN=-SIGN
      GOTO3200
 3225 IDIGI=IDIGI+1
      TERM=ITERM
      IEXP=IDIGI-1
      SUMI=SUMI+TERM*(10.0**IEXP)
 3200 CONTINUE
 3250 CONTINUE
      IF(ISIGN.GE.2)GOTO3900
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
C
      IDIGD=0
      SUMD=0.0
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.ISTOP2)GOTO3350
      DO3300I=ILOCP1,ISTOP2
      IF(IANS2(I).EQ.' ')GOTO3300
      IF(IANS2(I).EQ.'0')GOTO3310
      IF(IANS2(I).EQ.'1')GOTO3311
      IF(IANS2(I).EQ.'2')GOTO3312
      IF(IANS2(I).EQ.'3')GOTO3333
      IF(IANS2(I).EQ.'4')GOTO3314
      IF(IANS2(I).EQ.'5')GOTO3315
      IF(IANS2(I).EQ.'6')GOTO3316
      IF(IANS2(I).EQ.'7')GOTO3317
      IF(IANS2(I).EQ.'8')GOTO3318
      IF(IANS2(I).EQ.'9')GOTO3319
      IERROR='YES'
      GOTO3900
 3310 ITERM=0
      GOTO3325
 3311 ITERM=1
      GOTO3325
 3312 ITERM=2
      GOTO3325
 3333 ITERM=3
      GOTO3325
 3314 ITERM=4
      GOTO3325
 3315 ITERM=5
      GOTO3325
 3316 ITERM=6
      GOTO3325
 3317 ITERM=7
      GOTO3325
 3318 ITERM=8
      GOTO3325
 3319 ITERM=9
      GOTO3325
 3325 IDIGD=IDIGD+1
      TERM=ITERM
      SUMD=SUMD+TERM/(10.0**IDIGD)
 3300 CONTINUE
 3350 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IDIGT=IDIGI+IDIGD
      IF(IDIGT.LE.0)GOTO3900
      VALCON=SUMI+SUMD
      IVALCO=VALCON+0.00001
      IF(SIGN.LT.0.0)VALCON=-VALCON
      IF(SIGN.LT.0.0)IVALCO=-IVALCO
      IF(AMIN.LE.VALCON.AND.VALCON.LE.AMAX)GOTO3000
      GOTO3900
C
 3900 CONTINUE
      IF(IERROR.EQ.'YES')ITYPE2='WORD'
 3000 CONTINUE
 3999 CONTINUE
      GOTO9000
C
 9000 CONTINUE
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IERROR.EQ.'YES')IVALID='NO'
      IF(IERROR.EQ.'NO')IVALID='YES'
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9001)
 9001 FORMAT('***** AT THE END       OF DPCOHI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9002)IVALID,VALCON,IVALCO
 9002 FORMAT('IVALID,VALCON,IVALCO = ',A4,2X,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9005)IERROR
 9005 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOIH(IVAL,IHOUT,NOUT,IVALID,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CONVERT AN INTEGER VARIABLE
C              TO A 1-CHARACTER-PER-WORD HOLLARITH STRING.
C
C     ORIGINAL VERSION--JANUARY  1979.
C     UPDATED         --MAY      1986.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IHOUT
      CHARACTER*4 IVALID
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISIGN
      CHARACTER*4 IHDIG
C
      DIMENSION IHOUT(*)
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
C     MAXDIG IS THE MAXIMUM NUMBER OF DIGITS
C     FOR AN INTEGER VARIABLE.
C     THIS WILL VARY FROM ONE COMPUTER TO THE NEXT
C     DEPENDING ON THE NUMBER OF BITS FOR A WORD.
C     THE FOLLOWING DEFINED VALUE (= 10)
C     HAS BEEN SET FOR THE VAX 11/780.
C
CCCCC MAXDIG=11
      MAXDIG=9
      NUMDIG=(-999)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'COIH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOIH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,IERROR
   52 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IVAL
   53 FORMAT('IVAL = ',I11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMDIG
   54 FORMAT('NUMDIG = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      IERROR='NO'
      IVALID='YES'
      IVAL2=IVAL
C
C               ***********************
C               **  STEP 2--         **
C               **  DETERMINE SIGN.  **
C               ***********************
C
      ISIGN='+'
      IF(IVAL2.LT.0)ISIGN='-'
      IVAL2=IABS(IVAL2)
C
C               ***********************************
C               **  STEP 3--                     **
C               **  DETERMINE NUMBER OF DIGITS.  **
C               ***********************************
C
      IMIN=1
      IMAX=MAXDIG
      DO300I=IMIN,IMAX
      IREV=IMAX-I+IMIN
      IDIV=INT(10.0**(IREV-1) + 0.01)
      IDIG=IVAL2/IDIV
      IF(IDIG.NE.0)GOTO350
  300 CONTINUE
      NUMDIG=1
      GOTO390
  350 CONTINUE
      NUMDIG=IREV
  390 CONTINUE
C
C               ***************************************
C               **  STEP 4--                         **
C               **  IF NEGATIVE,                     **
C               **  INSERT SIGN INTO OUTPUT VECTOR.  **
C               ***************************************
C
      J=0
      IF(ISIGN.EQ.'-')J=J+1
      IF(ISIGN.EQ.'-')IHOUT(J)='-'
C
C               **************************
C               **  STEP 5--            **
C               **  INSERT DIGITS INTO  **
C               **  OUTPUT VECTOR.      **
C               **************************
C
      IMIN=1
      IMAX=NUMDIG
      DO500I=IMIN,IMAX
      IREV=IMAX-I+IMIN
      IDIV=INT(10.0**(IREV-1) + 0.01)
      IDIG=IVAL2/IDIV
C
      IF(IDIG.EQ.0)GOTO510
      IF(IDIG.EQ.1)GOTO511
      IF(IDIG.EQ.2)GOTO512
      IF(IDIG.EQ.3)GOTO513
      IF(IDIG.EQ.4)GOTO514
      IF(IDIG.EQ.5)GOTO515
      IF(IDIG.EQ.6)GOTO516
      IF(IDIG.EQ.7)GOTO517
      IF(IDIG.EQ.8)GOTO518
      IF(IDIG.EQ.9)GOTO519
  510 CONTINUE
      IHDIG='0'
      GOTO529
  511 CONTINUE
      IHDIG='1'
      GOTO529
  512 CONTINUE
      IHDIG='2'
      GOTO529
  513 CONTINUE
      IHDIG='3'
      GOTO529
  514 CONTINUE
      IHDIG='4'
      GOTO529
  515 CONTINUE
      IHDIG='5'
      GOTO529
  516 CONTINUE
      IHDIG='6'
      GOTO529
  517 CONTINUE
      IHDIG='7'
      GOTO529
  518 CONTINUE
      IHDIG='8'
      GOTO529
  519 CONTINUE
      IHDIG='9'
      GOTO529
  529 CONTINUE
C
      J=J+1
      IHOUT(J)=IHDIG
      IVAL2=IVAL2-IDIG*IDIV
  500 CONTINUE
      NOUT=J
C
C               ****************
C               **  STEP 6--  **
C               **  EXIT.     **
C               ****************
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'COIH')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOIH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IERROR
 9012 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IVAL
 9013 FORMAT('IVAL = ',I11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NOUT
 9014 FORMAT('NOUT = ',I11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(IHOUT(I),I=1,NOUT)
 9015 FORMAT('IHOUT(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOIP(XP,YP,XC,YC,SLOPE,ABSSLO,SLOEPS,
     1XHORIZ,AUPPER,ALOWER,NHORP,IPHORI,ICHORI,
     1ISTART,ICASHO,ICASIN,
     1XMIN,XMAX,
     1XTEMP2,YTEMP2,ITHORI,
     1IBUGU2,ISUBRO,IERROR)
C
C     PURPOSE--GIVEN THAT THE DATA LINE (XP,YP) TO (XC,YC)
C              IS SUCH THAT (XP,YP) IS TO THE
C              IMMEDIATE LEFT OF THE ISTART-TH ELEMENT
C              OF THE HORIZON TABLE,
C              DETERMINE THE INTERSECTION POINT
C              (XTEMP2,YTEMP2) WHERE THE DATA LINE
C              INTERSECTS THE HORIZON LINE.
C     ORIGINAL VERSION--SEPTEMBER 1988
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASHO
      CHARACTER*4 ICASIN
C
      CHARACTER*4 IBUGU2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION XHORIZ(*)
      DIMENSION AUPPER(*)
      DIMENSION ALOWER(*)
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='DPCO'
      ISUBN2='IP  '
C
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'COIP')GOTO50
      GOTO90
   50 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOIP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGU2,ISUBRO,IERROR
   52 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)XP,YP,XC,YC
   53 FORMAT('XP,YP,XC,YC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)SLOPE,ABSSLO,SLOEPS
   54 FORMAT('SLOPE,ABSSLO,SLOEPS = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NHORP,IPHORI,ICHORI
   61 FORMAT('NHORP,IPHORI,ICHORI = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO63I=IPHORI,ICHORI
      WRITE(ICOUT,64)I,XHORIZ(I),AUPPER(I),ALOWER(I)
   64 FORMAT('I,XHORIZ(I),AUPPER(I),ALOWER(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
      DO65I=IPHORI,ICHORI
      WRITE(ICOUT,66)I,AUPPER(I),ALOWER(I),XHORIZ(I)
   66 FORMAT('I,AUPPER(I),ALOWER(I),XHORIZ(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,67)ISTART,ICASHO,ICASIN
   67 FORMAT('ISTART,ICASHO,ICASIN = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)XMIN,XMAX
   68 FORMAT('XMIN,XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ITHORI
   72 FORMAT('ITHORI = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      I=ISTART-1
      IF(I.LE.0)I=1
      XTEMPO=XHORIZ(I)
      YTEMPO=YP+(XTEMPO-XP)*SLOPE
      YCUTOL=ALOWER(I)
      IF(ICASHO.EQ.'UPPE')YCUTOL=AUPPER(I)
C
      DO1100I=ISTART,ICHORI
      I2=I
      XTEMP=XHORIZ(I)
      YTEMP=YP+(XTEMP-XP)*SLOPE
      YCUT=ALOWER(I)
      IF(ICASHO.EQ.'UPPE')YCUT=AUPPER(I)
      IF(ICASIN.EQ.'LE'.AND.YTEMP.LE.YCUT)GOTO1150
      IF(ICASIN.EQ.'GE'.AND.YTEMP.GE.YCUT)GOTO1150
      XTEMPO=XTEMP
      YTEMPO=YTEMP
      YCUTOL=YCUT
 1100 CONTINUE
C
      XTEMP2=XC
      YTEMP2=YC
      ITHORI=ICHORI
      GOTO1190
C
 1150 CONTINUE
      IF(ABSSLO.LE.SLOEPS)GOTO1160
      GOTO1170
C
 1160 CONTINUE
      XTEMP2=XTEMP
      YTEMP2=YCUT
      ITHORI=I2
      GOTO1190
C
 1170 CONTINUE
      CALL DPCOI2(XTEMPO,YTEMPO,YCUTOL,XTEMP,YTEMP,YCUT,
     1XTEMP2,YTEMP2,IBUGU2,ISUBRO,IERROR)
      CALL HORIND(XTEMP2,XMIN,XMAX,1,NHORP,ITHORI,IBUGU2,ISUBRO,IERROR)
      GOTO1190
C
 1190 CONTINUE
      IF(ICASHO.EQ.'LOWE'.AND.YCUT.LT.ALOWER(ITHORI))ALOWER(ITHORI)=YCUT
      IF(ICASHO.EQ.'UPPE'.AND.YCUT.GT.AUPPER(ITHORI))AUPPER(ITHORI)=YCUT
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'COIP')GOTO9010
      GOTO9090
 9010 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END        OF DPCOIP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGU2,ISUBRO,IERROR
 9012 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)XP,YP,XC,YC
 9013 FORMAT('XP,YP,XC,YC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)SLOPE,ABSSLO,SLOEPS
 9014 FORMAT('SLOPE,ABSSLO,SLOEPS = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NHORP,IPHORI,ICHORI
 9021 FORMAT('NHORP,IPHORI,ICHORI = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO9023I=IPHORI,ICHORI
      WRITE(ICOUT,9024)I,XHORIZ(I),AUPPER(I),ALOWER(I)
 9024 FORMAT('I,XHORIZ(I),AUPPER(I),ALOWER(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9023 CONTINUE
      DO9025I=IPHORI,ICHORI
      WRITE(ICOUT,9026)I,AUPPER(I),ALOWER(I),XHORIZ(I)
 9026 FORMAT('I,AUPPER(I),ALOWER(I),XHORIZ(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9027)ISTART,ICASHO,ICASIN
 9027 FORMAT('ISTART,ICASHO,ICASIN = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)XMIN,XMAX
 9028 FORMAT('XMIN,XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)XTEMP2,YTEMP2
 9031 FORMAT('XTEMP2,YTEMP2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)ITHORI
 9032 FORMAT('ITHORI = ',I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOI2(X1,Y11,Y12,X2,Y21,Y22,
     1X3,Y3,IBUGU2,ISUBRO,IERROR)
C
C     PURPOSE--COMPUTE THE INTERSECTION POINT (X3,Y3) OF 2 LINES
C              FOR THE SPECIAL CASE WHEN ONLY HAVE
C              2 DISTINCT X VALUES  (RATHER THAN 4)
C              FOR THE 4 Y VALUES.
C              THUS ONE X VALUE HAS 2 Y VALUES,
C              AND THE OTHER X VALUE HAS 2 Y VALUES.
C     ASSUMPTION--THE 2 LINES DO IN FACT INTERSECT.
C     METHOD--FOR THIS SPECIAL CASE WHEN HAVE A COMMON
C             X VALUE FOR THE LEFT DATA AND ANOTHER COMMON
C             X VALUE FOR THE RIGHT DATA, THEN THE
C             SOLUTION FOR THE INTERSECTION POINT
C             IS GEOMETRICALLY QUITE SIMPLE--THE X VALUE IS
C             A CERTAIN PROPORTION P ACROSS AND
C             THE Y VALUE IS THE SAME PROPORTION P
C             BETWEEN THE Y VALUES ON A GIVEN LINE.
C             THAT PROPORTION IS
C                P = DEL1 /(DEL1 + DEL2)
C             WHERE DEL1 = DIFFERENCE OF Y VALUES ON LEFT,
C             AND   DEL2 = DIFFERENCE OF Y VALUES ON RIGHT.
C     ORIGINAL VERSION--SEPTEMBER 1988
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGU2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
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='DPCO'
      ISUBN2='I2  '
C
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'COI2')GOTO50
      GOTO90
   50 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGU2,ISUBRO,IERROR
   52 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y11,Y12
   53 FORMAT('X1,Y11,Y12 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y21,Y22
   54 FORMAT('X2,Y21,Y22 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 10--                                   **
C               **  COMPUTE THE INTERSECTION POINT              **
C               **************************************************
C
      YDEL1=Y12-Y11
      YDEL2=Y22-Y21
      YDEL2=(-YDEL2)
      YDEL12=YDEL1+YDEL2
      P=YDEL1/YDEL12
      X3=X1+P*(X2-X1)
      Y3=Y11+P*(Y21-Y11)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
      IF(IBUGU2.EQ.'ON'.OR.ISUBRO.EQ.'COI2')GOTO9010
      GOTO9090
 9010 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGU2,ISUBRO,IERROR
 9012 FORMAT('IBUGU2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y11,Y12
 9013 FORMAT('X1,Y11,Y12 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)X2,Y21,Y22
 9014 FORMAT('X2,Y21,Y22 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)YDEL1,YDEL2,YDEL12,P
 9021 FORMAT('YDEL1,YDEL2,YDEL12,P = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)X3,Y3
 9022 FORMAT('X3,Y3 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE DPCOLL(IDEFC1,IDEFC2,IFCOL1,IFCOL2,NUMRCM,
     1IFCOLL,IFCOLU,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE COLUMN LIMITS
C              WHICH WILL DEFINE THE EXTREME
C              COLUMNS (WITHIN A FILE) TO BE SCANNED IN CARRYING
C              OUT THE READ AND SERIAL READ COMMANDS.
C              THE 2 LIMITS ARE CONTAINED IN THE
C              2 ARGUMENTS IFCOL1 AND IFCOL2, RESPECTIVELY.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C                     --IDEFC1
C                     --IDEFC2
C     OUTPUT ARGUMENTS--IFCOL1 (AN INTEGER VARIABLE
C                       CONTAINING THE MINIMUM COLUMN
C                       IN THE DATA FILE TO BE SCANNED
C                       DURING A    READ    OR A    SERIAL READ.
C                     --IFCOL2 (AN INTEGER VARIABLE
C                       CONTAINING THE MAXIMUM COLUMN
C                       IN THE DATA FILE TO BE SCANNED
C                       DURING A    READ    OR A    SERIAL READ.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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  1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  2003. TEST AGAINST MAXIMUM RECORD
C                                       LENGTH FOR DATA FILE (NUMRCM)
C     UPDATED         --JANUARY   2004. IFCOLL, IFCOLU FOR ARRAYS OF
C                                       COLUMN LIMITS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 MESSAG
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      INTEGER IFCOL3(50)
      INTEGER AINDEX(50)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOM2.INC'
C
      DIMENSION IFCOLL(*)
      DIMENSION IFCOLU(*)
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
      IHOLD1=0
      IHOLD2=0
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE COLUMN LIMITS ARE TO BE CHANGED           **
C               ****************************************************
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LIMI')GOTO1110
      GOTO1190
C
 1110 CONTINUE
      IF(NUMARG.EQ.1)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(NUMARG.GE.3.AND.IARGT(2).EQ.'NUMB'.AND.
     1IARGT(3).EQ.'NUMB')GOTO1130
      IF(NUMARG.GE.3.AND.IARGT(2).EQ.'WORD'.AND.
     1IARGT(3).EQ.'WORD')GOTO3140
      GOTO1190
C
 1120 CONTINUE
      I1=IDEFC1
      I2=IDEFC2
      IF(I1.LE.I2)IHOLD1=I1
      IF(I1.LE.I2)IHOLD2=I2
      IF(I1.GT.I2)IHOLD1=I2
      IF(I1.GT.I2)IHOLD2=I1
      DO1122I=1,50
        IFCOLL(I)=0
        IFCOLU(I)=0
 1122 CONTINUE
      GOTO1180
C
 1130 CONTINUE
      I1=IARG(2)
      I2=IARG(3)
      IF(I1.LE.I2)IHOLD1=I1
      IF(I1.LE.I2)IHOLD2=I2
      IF(I1.GT.I2)IHOLD1=I2
      IF(I1.GT.I2)IHOLD2=I1
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFCOL1=IHOLD1
      IFCOL2=IHOLD2
C
CCCCC FEBRAURY 2003: CHECK AGAINST MAXIMUM RECORD LENGTH
C
      IF(IFCOL2.GT.NUMRCM)IFCOL2=NUMRCM
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE COLUMN LIMITS (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)IFCOL1,IFCOL2
 1186 FORMAT('HAVE JUST BEEN SET TO ',I8,I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 1190 CONTINUE
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE COLUMN MINIMUM IS TO BE CHANGED           **
C               ****************************************************
C
 1200 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MINI')GOTO1210
      GOTO1290
C
 1210 CONTINUE
      IF(NUMARG.EQ.1)GOTO1220
      IF(IHARG(NUMARG).EQ.'ON')GOTO1220
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1220
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1220
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')GOTO1230
      GOTO1290
C
 1220 CONTINUE
      IHOLD1=IDEFC1
      DO1222I=1,50
        IFCOLL(I)=0
        IFCOLU(I)=0
 1222 CONTINUE
      GOTO1280
C
 1230 CONTINUE
      IHOLD1=IARG(2)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IFCOL1=IHOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1285)
 1285 FORMAT('THE COLUMN MINIMUM (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1286)IFCOL1
 1286 FORMAT('HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO9000
C
 1290 CONTINUE
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE COLUMN MAXIMUM IS TO BE CHANGED           **
C               ****************************************************
C
 1300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MAXI')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      IF(NUMARG.EQ.1)GOTO1320
      IF(IHARG(NUMARG).EQ.'ON')GOTO1320
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1320
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1320
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')GOTO1330
      GOTO1390
C
 1320 CONTINUE
      IHOLD2=IDEFC2
      DO1322I=1,50
        IFCOLL(I)=0
        IFCOLU(I)=0
 1322 CONTINUE
      GOTO1380
C
 1330 CONTINUE
      IHOLD2=IARG(2)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IFCOL2=IHOLD2
C
CCCCC FEBRAURY 2003: CHECK AGAINST MAXIMUM RECORD LENGTH
C
      IF(IFCOL2.GT.NUMRCM)IFCOL2=NUMRCM
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1385)
 1385 FORMAT('THE COLUMN MAXIMUM (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1386)IFCOL1
 1386 FORMAT('HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO9000
C
 1390 CONTINUE
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)IFCOL1,IFCOL2
 8111 FORMAT('THE CURRENT COLUMN LIMITS ARE ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFC1,IDEFC2
 8112 FORMAT('THE DEFAULT COLUMN LIMITS ARE ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 3140 CONTINUE
C
      IH11=IHARG(2)
      IH12=IHARG2(2)
      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.'NO')THEN
        ICOL1=IVALUE(ILOCV)
        N1=IN(ILOCV)
      ELSE
        GOTO9000
      ENDIF
C
      IH11=IHARG(3)
      IH12=IHARG2(3)
      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.'NO')THEN
        ICOL2=IVALUE(ILOCV)
        N2=IN(ILOCV)
      ELSE
        GOTO9000
      ENDIF
C
      IF(N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3411)
 3411   FORMAT('***** ERROR: FOR THE VECTOR FORM OF THE COLUMN LIMITS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3413)
 3413   FORMAT('      COMMAND, THE NUMBER OF COLUMNS IS NOT EQUAL.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3415)IHARG(2),IHARG2(2),N1
 3415   FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3415)IHARG(3),IHARG2(3),N2
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      J=0
      IMAX=MIN(50,N1)
      DO3160I=1,50
        J=J+1
        IFCOLL(J)=0
        IFCOLU(J)=0
        IF(I.GT.IMAX)GOTO3160
C
        IJ=MAXN*(ICOL1-1)+I
        IF(ICOL1.LE.MAXCOL)IFCOLL(J)=INT(V(IJ) + 0.5)
        IF(ICOL1.EQ.MAXCP1)IFCOLL(J)=INT(PRED(I) + 0.5)
        IF(ICOL1.EQ.MAXCP2)IFCOLL(J)=INT(RES(I) + 0.5)
        IF(ICOL1.EQ.MAXCP3)IFCOLL(J)=INT(YPLOT(I) + 0.5)
        IF(ICOL1.EQ.MAXCP4)IFCOLL(J)=INT(XPLOT(I) + 0.5)
        IF(ICOL1.EQ.MAXCP5)IFCOLL(J)=INT(X2PLOT(I) + 0.5)
        IF(ICOL1.EQ.MAXCP6)IFCOLL(J)=INT(TAGPLO(I) + 0.5)
C
        IJ=MAXN*(ICOL2-1)+I
        IF(ICOL2.LE.MAXCOL)IFCOLU(J)=INT(V(IJ) + 0.5)
        IF(ICOL2.EQ.MAXCP1)IFCOLU(J)=INT(PRED(I) + 0.5)
        IF(ICOL2.EQ.MAXCP2)IFCOLU(J)=INT(RES(I) + 0.5)
        IF(ICOL2.EQ.MAXCP3)IFCOLU(J)=INT(YPLOT(I) + 0.5)
        IF(ICOL2.EQ.MAXCP4)IFCOLU(J)=INT(XPLOT(I) + 0.5)
        IF(ICOL2.EQ.MAXCP5)IFCOLU(J)=INT(X2PLOT(I) + 0.5)
        IF(ICOL2.EQ.MAXCP6)IFCOLU(J)=INT(TAGPLO(I) + 0.5)
C
 3160 CONTINUE
C
      DO3180I=1,IMAX
        IF(IFCOLL(I).GT.IFCOLU(I))THEN
          ITEMP=IFCOLL(I)
          IFCOLL(I)=IFCOLU(I)
          IFCOLU(I)=ITEMP
        ENDIF
 3180 CONTINUE
C
C  SORT THE COLUMNS (FROM SMALLEST TO LARGEST VALUE OF IFCOLL)
C
      CALL SORTII(IFCOLL,IMAX,IFCOL3,AINDEX)
      DO3187I=1,IMAX
        IFCOLL(I)=IFCOL3(I)
 3187 CONTINUE
C
      DO3188I=1,IMAX
        J=AINDEX(I)
        IFCOL3(I)=IFCOLU(J)
 3188 CONTINUE
C
      DO3189I=1,IMAX
        IFCOLU(I)=IFCOL3(I)
 3189 CONTINUE
C
      IFCOL1=IFCOLL(1)
      IFCOL2=IFCOLU(IMAX)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3191)
 3191 FORMAT('THE FOLLOWING COLUMN LIMITS HAVE BEEN SET:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3193)
 3193 FORMAT('VARIABLE         LOWER LIMIT      UPPER LIMIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3195)
 3195 FORMAT('---------------------------------------------')
      CALL DPWRST('XXX','BUG ')
      DO3199I=1,IMAX
        WRITE(ICOUT,3197)I,IFCOLL(I),IFCOLU(I)
        CALL DPWRST('XXX','BUG ')
 3199 CONTINUE
 3197 FORMAT(I8,12X,I8,9X,I8)
C
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPCOLO(IHARG,NUMARG,
     1IDEFCO,
     1ITEXCO,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE LINES
C              IN TEXT AND FIGURES.
C              THE COLOR WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXCO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--ITEXCO
C                     --IBUGD2
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCO
      CHARACTER*4 ITEXCO
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      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(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOLO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFCO
   53 FORMAT('IDEFCO = ',A4)
      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)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C     THE FOLLOWING LINES HAVE BEEN COMMENTED OUT (NOV. 1983)
C     DUE TO CONFLICTS WITH THE DPDECL SUBROUTINE
C     WHICH SPECIFIES WHETHER OR NOT THE TERMINAL
C     IS A COLOR DEVICE OR NOT.
C
CCCCC IF(NUMARG.EQ.0)GOTO1160
      IF(NUMARG.EQ.0)GOTO9000
CCCCC IF(IHARG(NUMARG).EQ.'ON')GOTO1160
      IF(IHARG(NUMARG).EQ.'ON')GOTO9000
CCCCC IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'OFF')GOTO9000
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1160
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1170
C
 1160 CONTINUE
      ITEXCO=IDEFCO
      GOTO1180
C
 1170 CONTINUE
      ITEXCO=IHARG(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 COLOR (FOR LINES IN TEXT AND FIGURES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXCO
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOLO--')
      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)IDEFCO,ITEXCO
 9013 FORMAT('IDEFCO,ITEXCO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOMB(Y,X,N,MINSIZ,
     1Y2,XLOW,XUPP,N2,IBUGA3,IERROR)
C
C     PURPOSE--FOR THE CHI-SQUARE GOODNESS OF FIT, IT IS RECOMMENDED
C              THAT CLASSES WITH LESS THAN 5 OBSERVATIONS BE COMBINED
C              IN ORDER FOR THE CHI-SQUARE GOODNESS OF FIT TES TO BE
C              VALID.  THE COMMAND IS:
C
C                 LET Y2 XLOW XHIGH = COMBINE FREQUENCY TABLE YCOUNT XMID
C
C              IT IS ASSUMED THAT THE INPUT CLASSES HAVE EQUAL WIDTH
C              AND THERE ARE NO MISSING CLASSES.
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 BUREAU OF STANDARDS.
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/10
C     ORIGINAL VERSION--OCTOBER   2004.
C     UPDATED         --FEBRUARY  2006. MODIFY ALGORITHM.
C                                       ORIGINAL ALGORITHM JUST WENT
C                                       FROM LEFT TO RIGHT.  REVISE
C                                       TO GO FROM LEFT TO CENTER
C                                       AND THEN FROM RIGHT TO
C                                       CENTER.  DO THIS SINCE WE
C                                       TYPICALLY WANT TO COMBINE
C                                       BINS WITH SMALL COUNTS IN
C                                       THE TAILS.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION XLOW(*)
      DIMENSION XUPP(*)
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='DPCO'
      ISUBN2='MB  '
C
      IERROR='NO'
C
      CALL SORTC(X,Y,N,X,Y)
C
      N2=0
      IFLAG=0
      ISTRT=1
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LT.2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN COMBINE FREQUENCY TABLE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF INPUT CLASSES IS LESS THAN TWO.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N
   34   FORMAT('      THE ENTERED NUMBER OF INPUT CLASSES HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO60I=1,N
        IF(Y(I).LT.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,31)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,62)
   62     FORMAT('      A NEGATIVE FREQUENCY WAS ENCOUNTERED.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,63)I,Y(I)
   63     FORMAT('      ROW ',I8,' = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
   60 CONTINUE
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,70)
   70   FORMAT('***** AT THE BEGINNING OF DPCOMB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)N,MINSIZ
   72   FORMAT('N,MINSIZ = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,N
          WRITE(ICOUT,74)I,X(I),Y(I)
   74     FORMAT('I,X(I),Y(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
C               **********************************************
C               **  STEP 2--                                **
C               **  COMBINE CLASSES WITH A FREQUECNY LESS   **
C               **  THAN MINSIZ.                            **
C               **********************************************
C
      DELTA=X(2) - X(1)
      DO100I=2,N
        ATEMP=X(I) - X(I-1)
        IF(ATEMP.LT.DELTA)DELTA=ATEMP
  100 CONTINUE
      AINC=DELTA/2.0
C
      AMINSZ=REAL(MINSIZ)
      IFLAG=0
      ICNT=0
      ISTRT=-1
      EPS=1.0E-10
C
C  FEBRUARY 2006:  SINCE SMALL FREQUENCIES TEND TO OCCUR IN THE
C                  TAILS, MODIFY THE ALGORITHM TO WORK FROM THE
C                  LEFT TAIL TO THE CENTER AND THEN THE RIGHT
C                  TAIL TO THE CENTER (ORIGINAL IMPLEMENTATION
C                  WENT FROM LEFT TAIL TO RIGHT TAIL).
C
CCCCC DO200I=1,N
CCCCC   AMID=X(I)
CCCCC   ATEMP=REAL(INT(Y(I)+0.5))
CCCCC   IF(IFLAG.EQ.0)THEN
CCCCC     IF(ATEMP+EPS.GE.AMINSZ)THEN
CCCCC       ICNT=ICNT+1
CCCCC       XLOW(ICNT)=AMID - AINC
CCCCC       XUPP(ICNT)=AMID + AINC
CCCCC       Y2(ICNT)=ATEMP
CCCCC     ELSE
CCCCC       IFLAG=1
CCCCC       ASUM=ATEMP
CCCCC       ISTRT=I
CCCCC     ENDIF
CCCCC   ELSE
CCCCC     ASUM=ASUM + ATEMP
CCCCC     IF(ASUM+EPS.GE.AMINSZ)THEN
CCCCC       ICNT=ICNT + 1
CCCCC       XLOW(ICNT)=X(ISTRT) - AINC
CCCCC       XUPP(ICNT)=AMID + AINC
CCCCC       Y2(ICNT)=ASUM
CCCCC       ISTRT=-1
CCCCC       IFLAG=0
CCCCC     ENDIF
CCCCC   ENDIF
CC200 CONTINUE
C
CCCCC IF(IFLAG.EQ.1 .AND. ASUM.GT.0.0)THEN
CCCCC   XUPP(ICNT)=X(N) + AINC
CCCCC   Y2(ICNT)=Y2(ICNT) + ASUM
CCCCC ENDIF
CCCCC N2=ICNT
C
       IMID=N/2
C
C  LEFT TAIL TO CENTER
C
      DO200I=1,IMID
        AMID=X(I)
        ATEMP=REAL(INT(Y(I)+0.5))
        IF(IFLAG.EQ.0)THEN
          IF(ATEMP+EPS.GE.AMINSZ)THEN
            ICNT=ICNT+1
            XLOW(ICNT)=AMID - AINC
            XUPP(ICNT)=AMID + AINC
            Y2(ICNT)=ATEMP
          ELSE
            IFLAG=1
            ASUM=ATEMP
            ISTRT=I
          ENDIF
        ELSE
          ASUM=ASUM + ATEMP
          IF(ASUM+EPS.GE.AMINSZ)THEN
            ICNT=ICNT + 1
            XLOW(ICNT)=X(ISTRT) - AINC
            XUPP(ICNT)=AMID + AINC
            Y2(ICNT)=ASUM
            ISTRT=-1
            IFLAG=0
          ENDIF
        ENDIF
  200 CONTINUE
C
      IF(IFLAG.EQ.1 .AND. ASUM.GT.0.0)THEN
        XUPP(ICNT)=X(IMID) + AINC
        Y2(ICNT)=Y2(ICNT) + ASUM
      ENDIF
      IFLAG=0
      N2LEFT=ICNT
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,270)
  270   FORMAT('***** DPCOMB--AFTER LEFT TAIL FREQUENCIES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,272)IMID,ICNT
  272   FORMAT('IMID,ICNT = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO273I=1,ICNT
          WRITE(ICOUT,274)I,XLOW(I),XUPP(I),Y2(I)
  274     FORMAT('I,XLOW(I),XUPP(I),Y2(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
  273   CONTINUE
      ENDIF
C
C
C  RIGHT TAIL TO CENTER.  TEMPORARILY STORE IN UPPER PART OF
C  XLOW, XUPP, AND Y2 ARRARYS, WILL THEN FLIP THE SORT AT THE
C  END.
C
      ICNT2=N
      IMID2=IMID+1
      IF(IMID2.GT.N)THEN
        N2=ICNT
        GOTO9000
      ENDIF
C
      DO300I=N,IMID2,-1
        AMID=X(I)
        ATEMP=REAL(INT(Y(I)+0.5))
        IF(IFLAG.EQ.0)THEN
          IF(ATEMP+EPS.GE.AMINSZ)THEN
            ICNT2=ICNT2+1
            XLOW(ICNT2)=AMID - AINC
            XUPP(ICNT2)=AMID + AINC
            Y2(ICNT2)=ATEMP
          ELSE
            IFLAG=1
            ASUM=ATEMP
            ISTOP=I
          ENDIF
        ELSE
          ASUM=ASUM + ATEMP
          IF(ASUM+EPS.GE.AMINSZ)THEN
            ICNT2=ICNT2 + 1
            XLOW(ICNT2)=AMID - AINC
            XUPP(ICNT2)=X(ISTOP) + AINC
            Y2(ICNT2)=ASUM
            ISTOP=-1
            IFLAG=0
          ENDIF
        ENDIF
  300 CONTINUE
C
      IF(IFLAG.EQ.1 .AND. ASUM.GT.0.0)THEN
        XLOW(ICNT2)=X(IMID2) - AINC
        Y2(ICNT2)=Y2(ICNT2) + ASUM
      ENDIF
      N2RGHT=ICNT2
C
C  NOW COPY REVERSE ORDER RIGHT TAIL ENTRIES
C
      DO400I=ICNT2,N+1,-1
        ICNT=ICNT+1
        Y2(ICNT)=Y2(I)
        XLOW(ICNT)=XLOW(I)
        XUPP(ICNT)=XUPP(I)
  400 CONTINUE
      N2=ICNT
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END OF DPCOMB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR,N2
 9012   FORMAT('IERROR,N2 = ',A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,N2
          WRITE(ICOUT,9016)I,Y2(I),XLOW(I),XUPP(I)
 9016     FORMAT('I,Y2(I),XLOW(I),XUPP(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCOMM(IHARG,NUMARG,
     1IDEFCZ,
     1ICOMCH,
     1ICOMFL,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COMMENT CHARACTOR (DEFAULT IS ".").
C              ALSO CHECK FOR "COMMENT CHECK ON/OFF" COMMAND).
C
C              THE COMMENT CHARACTER IS STORED IN 4 CHARACTERS,
C              BUT ONLY THE FIRST CHARACTER IS USED.
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFCZ (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--ICOMCH (A CHARACTER VARIABLE)
C                     --ICOMFL (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MAY      1990.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFCZ
      CHARACTER*4 ICOMCH
      CHARACTER*4 ICOMFL
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
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
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOMM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFCZ
   53 FORMAT('IDEFCZ = ',A4)
      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)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1.OR.NUMARG.GE.3)GOTO9000
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(1).EQ.'CHAR')GOTO1120
      IF(IHARG(1).EQ.'CHEC')GOTO2120
      GOTO2120
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'AUTO')GOTO1150
      IF(IHARG(2).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCZ
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(2)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ICOMCH=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ICOMCH(1:1)
 1181 FORMAT('THE COMMENT CHARACTER HAS JUST BEEN SET TO ',
     1A1)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 2120 CONTINUE
      IF(IHARG(2).EQ.'ON')GOTO2150
      IF(IHARG(2).EQ.'OFF')GOTO2160
      IF(IHARG(2).EQ.'AUTO')GOTO2150
      IF(IHARG(2).EQ.'DEFA')GOTO2150
      GOTO2160
C
 2150 CONTINUE
      IHOLD='ON'
      GOTO2180
C
 2160 CONTINUE
      IHOLD='OFF'
      GOTO2180
C
 2180 CONTINUE
      IFOUND='YES'
      ICOMFL=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO2189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(ICOMFL.EQ.'ON')WRITE(ICOUT,2181)
 2181 FORMAT('THE FIRST CHARACTER OF DATA FILES WILL BE CHECKED ',
     1'FOR THE COMMENT CHARACTER.')
      IF(ICOMFL.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICOMFL.EQ.'OFF')WRITE(ICOUT,2182)
 2182 FORMAT('THE FIRST CHARACTER OF DATA FILES WILL NOT BE ',
     1'CHECKED FOR THE COMMENT CHARACTER.')
      IF(ICOMFL.EQ.'OFF')CALL DPWRST('XXX','BUG ')
 2189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOMM-')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFCZ,ICOMCH
 9013 FORMAT('IDEFCZ,ICOMCH = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOMV(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM
C              1) AUTOCOMOVEMENT PLOT
C              2) COMOVEMENT PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/10
C     ORIGINAL VERSION--OCTOBER   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHVA21
      CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION YTEMP1(MAXOBV)
      DIMENSION YTEMP2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB4),YTEMP2(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPCO'
      ISUBN2='RR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
C               *************************************************************
C               **  TREAT THE FOLLOWING CASES--                             *
C               **        1) AUTOCOMOVEMENT                                 *
C               **        2) COMOVEMENT                                     *
C               *************************************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COMV')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN FEBRUARY 1993
C               ***************************************
C               **  STEP 1.1--                       **
C               **  SEARCH FOR AUTOCOMOVEMENT  PLOT  **
C               ***************************************
C
      ICASPL='AUCO'
C
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'COMO'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COMO'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'-COM'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
C
C               *****************************************
C               **  STEP 1.2--                         **
C               **  SEARCH FOR COMOVEMENT        PLOT  **
C               **  SEARCH FOR CROSS COMOVEMENT  PLOT  **
C               *****************************************
C
      ICASPL='COMO'
C
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'COMO'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'COMO'.AND.ICOM2.EQ.'VEME'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SCOM'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'CROS'.AND.ICOM2.EQ.'S-CO'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
C
C               ************************************************
C               **  STEP 1.3--                                **
C               **  SEARCH FOR PARTIAL AUTO-COMOVEMEMNT PLOT  **
C               **  (THIS CASE NOT SUPPORTED YET)             **
C               ************************************************
C
      ICASPL='PACO'
C
      IF(NUMARG.GE.3)THEN
         IF(ICOM.EQ.'PART'.AND.IHARG(1).EQ.'AUTO'.AND.
     1   IHARG(2).EQ.'COMO'.AND.IHARG(3).EQ.'PLOT')GOTO113
      ENDIF
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'PART'.AND.IHARG(1).EQ.'AUTO'.AND.
     1   IHARG2(1).EQ.'COMO'.AND.IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
C
      ICASPL='    '
      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
  113 CONTINUE
      ILASTC=3
      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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASPL.EQ.'AUCO')GOTO270
      IF(ICASPL.EQ.'COMO')GOTO280
C
  260 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPCOMV')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,264)
  264 FORMAT('      AUCO OR COMO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,IWIDTH)
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  280 CONTINUE
      MAXV2=2
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL 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 POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH AN AUTO COMOVEMENT OR COMOVEMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      ANALYSIS IS TO BE 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)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='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
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COMV')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                             **
C               **  (EXACTLY 1                               **
C               **  FOR AN AUTOCOMOVEMEMNT PLOT              **
C               **  EXACTLY 2                                **
C               **  FOR A COMOVEMENT        PLOT.            **
C               **  ALSO, FOR A COMOVEMENT       PLOT,       **
C               **  CHECK THE VALIDITY                       **
C               **  OF THE SECOND VARIABLE.                  **
C               **  DOES THE NAME EXIST IN THE TABLE?        **
C               **  DOES THE NUMBER OF ELEMENTS              **
C               **  IN THE SECOND VARIABLE                   **
C               **  AGREE WITH THE NUMBER OF ELEMENTS        **
C               **  IN THE FIRST VARIABLE?                   **
C               ***********************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO509
      GOTO550
C
  509 CONTINUE
      IF(NUMV2.LE.1)GOTO590
      IHVA21=IHARG(2)
      IHVA22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVA21,IHVA22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV2=IVALUE(ILOCV)
      NVAR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHVA21,IHVA22,ICOLV2,NVAR2
  511 FORMAT('IHVA21,IHVA22,ICOLV2,NVAR2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NVAR2.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A COMOVEMENT PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)NUMV2
  557 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A COMOVEMENT PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)IHLEFT,IHLEF2,NLEFT
  577 FORMAT('      THE FIRST  VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)IHVA21,IHVA22,NVAR2
  578 FORMAT('      THE SECOND VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,580)(IANS(I),I=1,IWIDTH)
  580 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE FIRST  VARIABLE; **
C               **  ALSO, FOR A COMOVEMEMNT       PLOT,     **
C               **  FORM THE VARIABLE Y2(.)                 **
C               **  WHICH WILL CONTAIN THE SECOND VARIABLE. **
C               **  FORM THESE VARIABLES BY                 **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO610
      IF(ICASQ.EQ.'SUBS')GOTO620
      IF(ICASQ.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
      IF(NQ.GE.MINN2)GOTO660
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)
  651 FORMAT('***** ERROR IN DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)
  652 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)IHLEFT,IHLEF2
  653 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      (FOR WHICH AN AUTOCOMOVEMENT OR COMOVEMENT PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      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)
      IF(MAXV2.LE.1)GOTO670
C
      IJ=MAXN*(ICOLV2-1)+I
      IF(ICOLV2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLV2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLV2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLV2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLV2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLV2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLV2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C               **********************************************************
C               **  STEP 8--                                            **
C               **  DETERMINE IF THE ANALYST                            **
C               **  HAS SPECIFIED THE NUMBER OF LAGS DESIRED            **
C               **  FOR THE CROSS-CORRELATION PLOT.                     **
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='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     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')GOTO790
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')GOTO790
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')GOTO790
C
  790 CONTINUE
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COMV')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPCOM2(Y1,Y2,NS,ICASPL,NUMLAG,MAXN,
     1Y,X,D,YTEMP1,YTEMP2,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COMV')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOMV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMLAG,MAXN
 9014 FORMAT('NUMLAG,MAXN = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOM2(Y1,Y2,N,ICASPL,NUMLAG,MAXN,
     1Y,X,D,YTEMP1,YTEMP2,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) AN AUTOCOMOVEMENT PLOT
C                   2) A COMOVEMENT PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/10
C     ORIGINAL VERSION--OCTOBER   1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
      DIMENSION YTEMP1(*)
      DIMENSION YTEMP2(*)
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='DPCO'
      ISUBN2='M2  '
C
      IERROR='NO'
C
      J=(-999)
      KMAX=(-999)
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPCOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=Y1(1)
      DO60I=1,N
      IF(Y1(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPCOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COM2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPCOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMLAG,MAXN
   71 FORMAT('N,ICASPL,NUMLAG,MAXN = ',I8,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y1(I),Y2(I)
   74 FORMAT('I, Y1(I), Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
C               *******************************
C               **  STEP 2--                 **
C               **  IF NECESSARY,            **
C               **  COMPUTE THE MAXIMUM LAG  **
C               *******************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXLAG=MAXN
      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--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IF(ICASPL.EQ.'AUCO')GOTO1000
      IF(ICASPL.EQ.'COMO')GOTO2000
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPCOM2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      AUCO OR COMO, BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ******************************************************
C               **  STEP 4.1--                                      **
C               **  COMPUTE THE AUTOCOMOVEMEMNTS FOR THE X  DATA    **
C               **  CALL THE COMOVE SUBROUTINE TO COMPUTE           **
C               ******************************************************
C
 1000 CONTINUE
      ISTEPN='4.1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1100 CONTINUE
C
      IWRITE='OFF'
C
      J=1
      X(J)=0.0
      Y(J)=1.0
      D(J)=1.0
C
      DO1110K=1,KMAXM1
        NMK=N-K
        ANMK=NMK
        DO1120I=1,NMK
          JJ=I+K
          YTEMP1(I)=Y1(I)
          YTEMP2(I)=Y1(JJ)
 1120   CONTINUE
        CALL COMOVE(YTEMP1,YTEMP2,NMK,IWRITE,XYCOMO,IBUGG3,IERROR) 
        J=J+1
        X(J)=REAL(K)
        Y(J)=XYCOMO
        D(J)=1.0
 1110 CONTINUE
C
 1300 CONTINUE
      YMID=0.0
CCCCC SDR=1.0/SQRT(AN)
CCCCC YUPP95=1.96*SDR
CCCCC YLOW95=(-YUPP95)
CCCCC YUPP99=2.576*SDR
CCCCC YLOW99=(-YUPP99)
CCCCC IOUT=0
C
CCCCC J=J+1
CCCCC Y(J)=1.0
CCCCC X(J)=0.0
CCCCC DO1310K=1,KMAXM1
CCCCC J=J+1
CCCCC Y(J)=D(K)
CCCCC X(J)=K
CCCCC IF(Y(J).GT.YUPP95)IOUT=IOUT+1
CCCCC IF(Y(J).LT.YLOW95)IOUT=IOUT+1
 1310 CONTINUE
CCCCC AIOUT=IOUT
CCCCC AKMAXM=KMAXM1
CCCCC PEROUT=100.0*(AIOUT/AKMAXM)
C
CCCCC J=0
CCCCC J=J+1
CCCCC D(J)=1.0
CCCCC DO1320K=1,KMAXM1
CCCCC J=J+1
CCCCC D(J)=1.0
 1320 CONTINUE
C
C  CURRENTLY, DO NOT HAVE FORMULAS FOR REFERENCE LINES
C  (BUT DO ZERO LINE)
      DO342K=0,KMAXM1
         J=J+1
         Y(J)=YMID
         X(J)=K
         D(J)=2.0
  342 CONTINUE
C
CCCCC DO343K=1,KMAXM1
CCCCC    J=J+1
CCCCC    Y(J)=YUPP95
CCCCC    X(J)=K
CCCCC    D(J)=3.0
  343 CONTINUE
C
CCCCC DO344K=1,KMAXM1
CCCCC    J=J+1
CCCCC    Y(J)=YLOW95
CCCCC    X(J)=K
CCCCC    D(J)=4.0
  344 CONTINUE
C
CCCCC DO345K=1,KMAXM1
CCCCC    J=J+1
CCCCC    Y(J)=YUPP99
CCCCC    X(J)=K
CCCCC    D(J)=5.0
  345 CONTINUE
C
CCCCC DO346K=1,KMAXM1
CCCCC    J=J+1
CCCCC    Y(J)=YLOW99
CCCCC    X(J)=K
CCCCC    D(J)=6.0
  346 CONTINUE
C
      NPLOTP=J
      NPLOTV=3
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 4.2--                                          **
C               **  COMPUTE CROSS-CORRELATIONS FOR THE X AND 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
 2000 CONTINUE
      ISTEPN='4.2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      J=0
      L=(-KMAXM1-1)
      DO2110K=1,KMAXM1
        KREV=KMAXM1-K+1
        NMK=N-KREV
        ANMK=NMK
        DO2120I=1,NMK
          JJ=I+KREV
          YTEMP1(I)=Y1(JJ)
          YTEMP2(I)=Y2(I)
 2120   CONTINUE
        CALL COMOVE(YTEMP1,YTEMP2,NMK,IWRITE,XYCOMO,IBUGG3,IERROR) 
        J=J+1
        L=L+1
        X(J)=REAL(L)
        Y(J)=XYCOMO
        D(J)=1.0
 2110 CONTINUE
C
      J=J+1
      X(J)=0.0
      Y(J)=1.0
      D(J)=1.0
C
      DO2210K=1,KMAXM1
        NMK=N-K
        ANMK=NMK
        DO2220I=1,NMK
          JJ=I+K
          YTEMP1(I)=Y1(I)
          YTEMP2(I)=Y2(JJ)
 2220   CONTINUE
        CALL COMOVE(YTEMP1,YTEMP2,NMK,IWRITE,XYCOMO,IBUGG3,IERROR) 
        J=J+1
        X(J)=REAL(K)
        Y(J)=XYCOMO
        D(J)=1.0
 2210 CONTINUE
C
      YMID=0.0
      INDEX=J
CCCCC SDR=1.0/SQRT(AN)
CCCCC YUPP95=1.96*SDR
CCCCC YLOW95=(-YUPP95)
CCCCC YUPP99=2.576*SDR
CCCCC YLOW99=(-YUPP99)
C
CCCCC L=(-KMAXM1-1)
CCCCC DO2150J2=1,INDEX
CCCCC J=J2
CCCCC L=L+1
CCCCC Y(J)=1.0
CCCCC IF(DENOM.GT.0.0)Y(J)=D(J)/DENOM
CCCCC X(J)=L
CCCCC D(J)=1.0
 2150 CONTINUE
C
C  CURRENTLY, DO NOT HAVE FORMULAS FOR REFERENCE LINES
C
      DO2152K=1,INDEX
         J=J+1
         Y(J)=YMID
         X(J)=X(K)
         D(J)=2.0
 2152 CONTINUE
C
CCCCC DO2153K=1,INDEX
CCCCC    J=J+1
CCCCC    Y(J)=YUPP95
CCCCC    X(J)=X(K)
CCCCC    D(J)=3.0
 2153 CONTINUE
C
CCCCC DO2154K=1,INDEX
CCCCC    J=J+1
CCCCC    Y(J)=YLOW95
CCCCC    X(J)=X(K)
CCCCC    D(J)=4.0
 2154 CONTINUE
C
CCCCC DO2155K=1,INDEX
CCCCC    J=J+1
CCCCC    Y(J)=YUPP99
CCCCC    X(J)=X(K)
CCCCC    D(J)=5.0
 2155 CONTINUE
C
CCCCC DO2156K=1,INDEX
CCCCC    J=J+1
CCCCC    Y(J)=YLOW99
CCCCC    X(J)=X(K)
CCCCC    D(J)=6.0
 2156 CONTINUE
C
      NPLOTP=J
      NPLOTV=3
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COM2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NUMLAG,N,KMAX,NPLOTP,IERROR
 9012 FORMAT('ICASPL,NUMLAG,N,KMAX,NPLOTP,IERROR = ',A4,4I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCON2(IVAL,VAL,IH,NH,NMDID0,IBUGD2,IERROR)
C
C     NOTE--EXCEPT FOR THE NMDID0 ARGUMENT
C           (AND SOME BUG WRITE STATEMENTS),
C           THIS SUBROUTINE IS IDENTICAL TO DPCONH.
C           IT HAS BEEN DUPLICATED AND PLACED
C           ON THIS BRANCH OF THE OVERLAY/SEGMENTATION
C           TREE STRUCTURE IN ORDER TO ACHIEVE
C           FASTER EXECUTION TIME.
C
C     NOTE--UPON INPUT, IVALUE IS USUALLY INT(VALUE+0.5), BUT
C           FOR NEGATIVE VALUE, IVALUE SHOULD BE INT(VALUE-0.5)
C
C     NOTE--NMDID0 = THE NUMBER OF DECIMAL
C           PLACES DESIRED A PRIORI.
C           IF NMDID0 IS NEGATIVE, THEN THIS IMPLIES
C           THAT THE ACTUAL NUMBER OF DECIMAL PLACES
C           DESIRED IS NOT SET A PRIORI AND SO SHOULD
C           FLOAT WITH THE DATA VALUE.
C
C     PURPOSE--CONVERT NUMERIC VALUE INTO CORRESPONDING
C              CHARACTER STRING.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MARCH   1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHREM
      CHARACTER*4 IHNUM
      CHARACTER*4 IHTEMI
      CHARACTER*4 IHTEMD
C
      DIMENSION IH(*)
      DIMENSION IHTEMI(10)
      DIMENSION IHTEMD(10)
C
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-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT---------------------------------------------------------
C
      AINUM=0.0
      FRACT=0.0
      NUMDID=0
      IMAX=0
C
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2')GOTO90
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2'.AND.IBUGD2.EQ.'OFF')
     1GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCON2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IVAL,VAL
   52 FORMAT('IVAL,VAL = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NMDID0
   53 FORMAT('NMDID0 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ABSVAL=ABS(VAL)
C
      AIVAL=IVAL
      DEL=AIVAL-VAL
      ABSDEL=ABS(DEL)
C
      ABSRAT=ABSDEL
      IF(ABSVAL.GE.1.0)ABSRAT=ABSDEL/ABSVAL
C
CCCCC CUTDEL=10.0**(-16)
      CUTDEL=10.0**(-6)
      CUTRAT=10.0**(-6)
C
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2')GOTO919
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2'.AND.IBUGD2.EQ.'OFF')
     1GOTO919
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,911)
  911 FORMAT('***** FROM THE MIDDLE OF DPCON2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,912)ABSVAL
  912 FORMAT('ABSVAL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)VAL,IVAL,AIVAL,DEL,ABSDEL
  913 FORMAT('VAL,IVAL,AIVAL,DEL,ABSDEL = ',E15.7,I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,914)ABSDEL,CUTDEL
  914 FORMAT('ABSDEL,CUTDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,915)ABSRAT,CUTRAT
  915 FORMAT('ABSRAT,CUTRAT = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
  919 CONTINUE
C
      IF(ABSVAL.LT.1.0.AND.ABSDEL.LE.CUTDEL)GOTO1000
      IF(ABSVAL.GE.1.0.AND.ABSRAT.LE.CUTRAT)GOTO1000
      GOTO2000
C
C               ******************************
C               **  STEP XX--               **
C               **  TREAT THE INTEGER CASE  **
C               ******************************
C
 1000 CONTINUE
C
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')WRITE(ICOUT,1005)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1WRITE(ICOUT,1005)
 1005 FORMAT('*****INTEGER CASE*****')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
C
      INUM=IABS(IVAL)
      NUMDII=0
      IF(INUM.EQ.0)NUMDII=NUMDII+1
      IF(INUM.EQ.0)IHTEMI(NUMDII)='0'
      IF(INUM.EQ.0)GOTO1190
C
      DO1100I=1,10
      IF(INUM.LE.0)GOTO1190
      IRATIO=INUM/10
      IREM=INUM-10*IRATIO
      INUM=IRATIO
      NUMDII=NUMDII+1
      CALL DPCOD2(IREM,IHREM,IBUGD2,IERROR)
      IHTEMI(NUMDII)=IHREM
 1100 CONTINUE
 1190 CONTINUE
      IF(IVAL.LT.0)NUMDII=NUMDII+1
      IF(IVAL.LT.0)IHTEMI(NUMDII)='-'
C
      NH=NUMDII
      IF(NUMDII.LE.0)GOTO1290
      DO1200I=1,NUMDII
      IREV=NUMDII-I+1
      IH(I)=IHTEMI(IREV)
 1200 CONTINUE
 1290 CONTINUE
C
      IF(NMDID0.GE.1)GOTO2500
      GOTO9000
C
C               **********************************
C               **  STEP XX--                   **
C               **  TREAT THE NON-INTEGER CASE  **
C               **********************************
C
 2000 CONTINUE
C
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')WRITE(ICOUT,2005)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1WRITE(ICOUT,2005)
 2005 FORMAT('*****NON-INTEGER CASE*****')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
C
      INUM=ABSVAL
      AINUM=INUM
      FRACT=ABSVAL-AINUM
C
      NUMDII=0
      IF(INUM.EQ.0)NUMDII=NUMDII+1
      IF(INUM.EQ.0)IHTEMI(NUMDII)='0'
      IF(INUM.EQ.0)GOTO2190
C
      DO2100I=1,10
      IF(INUM.LE.0)GOTO2190
      IRATIO=INUM/10
      IREM=INUM-10*IRATIO
      INUM=IRATIO
      NUMDII=NUMDII+1
      CALL DPCOD2(IREM,IHREM,IBUGD2,IERROR)
      IHTEMI(NUMDII)=IHREM
 2100 CONTINUE
 2190 CONTINUE
      IF(VAL.LT.0)NUMDII=NUMDII+1
      IF(VAL.LT.0)IHTEMI(NUMDII)='-'
C
      NUMDID=0
      IF(FRACT.EQ.0.0)NUMDID=0
      IF(FRACT.EQ.0.0)GOTO2390
C
      ANUM=FRACT
      NLOOP=8-NUMDII
CCCCC CUTOF2=10.0**(-NLOOP+1)
CCCCC CUTOF3=1.0-CUTOF2
      IF(NLOOP.LE.0)GOTO2390
      DO2300I=1,NLOOP
      CUTOF2=10.0**(-NLOOP+I+1)
      CUTOF3=1.0-CUTOF2
      ANUM=ANUM*10.0
      INUM=ANUM
      AINUM=INUM
      DEL3=ANUM-AINUM
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')WRITE(ICOUT,2311)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1WRITE(ICOUT,2311)
     1NLOOP,I,CUTOF3,CUTOF2
 2311 FORMAT('NLOOP,I,CUTOF3,CUTOF2 = ',I8,I8,2E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')WRITE(ICOUT,2312)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1WRITE(ICOUT,2312)
     1ANUM,AINUM,DEL3,CUTOF3
 2312 FORMAT('ANUM,AINUM,DEL3,CUTOF3 = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
      IF(DEL3.GE.CUTOF3)INUM=INUM+1
      IF(DEL3.GE.CUTOF3)ANUM=INUM
      NUMDID=NUMDID+1
      CALL DPCOD2(INUM,IHNUM,IBUGD2,IERROR)
      IHTEMD(NUMDID)=IHNUM
      AINUM=INUM
      DEL2=ANUM-AINUM
      ANUM=DEL2
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')WRITE(ICOUT,2313)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1WRITE(ICOUT,2313)
     1ANUM,AINUM,DEL2,CUTOF2
 2313 FORMAT('ANUM,AINUM,DEL2,CUTOF2 = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CON2'.OR.IBUGD2.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
      IF(DEL2.LE.CUTOF2)GOTO2390
 2300 CONTINUE
 2390 CONTINUE
C
      NH=0
      IF(NUMDII.LE.0)GOTO2490
      DO2400I=1,NUMDII
      NH=NH+1
      IREV=NUMDII-I+1
      IH(NH)=IHTEMI(IREV)
 2400 CONTINUE
 2490 CONTINUE
C
 2500 CONTINUE
      NH=NH+1
      IH(NH)='.'
C
      IMAX=NMDID0
      IF(NMDID0.LT.0)IMAX=NUMDID
C
      IF(IMAX.LE.0)GOTO2690
      DO2600I=1,IMAX
      NH=NH+1
      IF(NMDID0.LT.0)IH(NH)=IHTEMD(I)
      IF(NMDID0.GE.0.AND.I.LE.NUMDID)IH(NH)=IHTEMD(I)
      IF(NMDID0.GE.0.AND.I.GT.NUMDID)IH(NH)='0'
 2600 CONTINUE
 2690 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2')GOTO9090
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CON2'.AND.IBUGD2.EQ.'OFF')
     1GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCON2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IVAL,VAL
 9012 FORMAT('IVAL,VAL = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)AIVAL,VAL,DEL,ABSDEL,CUTDEL
 9013 FORMAT('AIVAL,VAL,DEL,ABSDEL,CUTDEL = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ABSVAL,INUM,AINUM,FRACT
 9014 FORMAT('ABSVAL,INUM,AINUM,FRACT = ',E15.7,2X,I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMDII
 9015 FORMAT('NUMDII = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(IHTEMI(I),I=1,NUMDII)
 9016 FORMAT('(IHTEMI(I),I=1,NUMDII) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)NMDID0,NUMDID,IMAX
 9025 FORMAT('NMDID0,NUMDID,IMAX = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)(IHTEMD(I),I=1,NUMDID)
 9026 FORMAT('(IHTEMD(I),I=1,NUMDID) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NH
 9031 FORMAT('NH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)(IH(I),I=1,NH)
 9032 FORMAT('(IH(I),I=1,NH) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOND(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1CLLIMI,CLWIDT,
     1ICONT,NUMHPP,NUMVPP,IMANUF,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ALOWFR,ALOWDG,
     1IFORSW,
     1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF,
     1ICAPSW,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE A CONDITIONING PLOT (COPLOT)
C            --ALLOWABLE SYNTAXES:
C                CONDITIONING PLOT Y COND
C                CONDITIONING PLOT Y X COND
C                CONDITIONING PLOT Y X COND TAG
C                CONDITIONING PLOT Y X COND1 COND2
C                CONDITIONING PLOT Y X COND1 COND2 TAG
C                CONDITIONING PLOT Y1 ... YK X COND TAG
C             --THAT IS, THERE ARE:
C               1) ONE OR MORE RESPONSE VARIABLES (DETERMINED BY
C                  SET COND PLOT RESPONSE VARIABLES 
C               2) AN OPTIONAL INDEPENDENT VARIABLE.  THIS IS
C                  DETERMINED BT THE PLOT TYPE.
C                  NOTE: 3D PLOT TYPES WILL HAVE EITHER 2 OR 3
C                  INDEPENDENT VARIABLES.
C               3) EITHER ONE OR TWO CONDITIONING VARIABLES (DETERMINED
C                  BY: SET COND PLOT CONDITION VARIABLES <1/2>)
C               4) AN OPTIONAL TAG VARIABLE (DETERMINED BY 
C                  SET COND PLOT TAG )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/9
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 ICASAN
      CHARACTER*4 ICONT
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IFORSW
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
      CHARACTER*4 IMPSW3
C
      CHARACTER*4 ICPLLD
      CHARACTER*4 ICPLDI
      CHARACTER*4 IEMPTY
      CHARACTER*4 IPPTB2
      CHARACTER*4 IFEED9
      CHARACTER*4 ICPLFZ
      CHARACTER*4 ICPLPZ
      CHARACTER*4 ICPLLZ
      CHARACTER*4 ICPLTZ
      CHARACTER*4 ICPLL2
      CHARACTER*4 ICPLXZ
      CHARACTER*4 ICPLYZ
      CHARACTER*4 ICPLDZ
      CHARACTER*4 ICPLZT
      CHARACTER*4 ICPLZ2
      CHARACTER*4 ICPLZ3
      CHARACTER*4 ICPLZ4
C
      CHARACTER*4 IMANUF
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 ISPIS2(100)
      CHARACTER*4 IBARS2(100)
      CHARACTER*4 IERAS2
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
      CHARACTER*4 IX1FSV
      CHARACTER*4 IX2FSV
      CHARACTER*4 IY1FSV
      CHARACTER*4 IY2FSV
      CHARACTER*4 ISORS2
      CHARACTER*4 ILFLAX
      CHARACTER*4 ILFLAY
      CHARACTER*4 IY1LJ2
      CHARACTER*4 IY1LD2
      CHARACTER*4 IX1LT2(MAXCH)
      CHARACTER*4 IX2LT2(MAXCH)
      CHARACTER*4 IY1LT2(MAXCH)
      CHARACTER*4 IY2LT2(MAXCH)
      CHARACTER*4 ITITSV(MAXCH)
C
      CHARACTER*4 IPLTTY
      CHARACTER*4 IPLOTT
      CHARACTER*4 IFLGIN
      CHARACTER*4 IFLGX
      CHARACTER*4 IFLGY
      CHARACTER*4 ISUBSZ
      CHARACTER*4 IWRITE
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
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*4 ICT
      CHARACTER*4 IC2T
      CHARACTER*4 IHT(25)
      CHARACTER*4 IH2T(25)
      CHARACTER*4 IARGTT(25)
      REAL ARGT(25)
      CHARACTER*4 ISU2SW(MAXSUB)
C
C  MAXY IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  CONDITIONING PLOT   CURVE
C
      PARAMETER(MAXY=50)
C
      DIMENSION IVARN1(MAXY)
      DIMENSION IVARN2(MAXY)
      DIMENSION ILIS(MAXY)
      DIMENSION ICOLL(MAXY)
C
CCCCC CHARACTER*4 IH11
CCCCC CHARACTER*4 IH12
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON------------------------------------------------------
C
      DIMENSION ADIST1(MAXY)
      DIMENSION ADIST2(MAXY)
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.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='YES'
      IERROR='NO'
C
      ISUBN1='DPCOND'
      ISUBN2='    '
C
      ICASPL='COND'
      ICPLLD='ON'
      ICPLDI='BLAN'
C
      IPLTTY='BIVA'
      IF(ICPLPT.EQ.'HIST')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'RUNS')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'PERC')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'AUTO')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'LAG ')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'PROB')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'PPCC')IPLTTY='UNIV'
      IF(ICPLPT.EQ.'DENS')IPLTTY='UNIV'
      ICPLXV=1
      IF(IPLTTY.EQ.'UNIV')ICPLXV=0
      IF(ICPLPT.EQ.'YACU')ICPLXV=3
      IF(ICPLPT.EQ.'3DPL')ICPLXV=2
C
      ICPLRV=INT(PCPLRV+0.5)
      IF(ICPLRV.LT.1)ICPLRV=1
      ITAG=0
      IF(ICPLTA.EQ.'ON'.AND.ICPLPT.EQ.'PLOT')ITAG=1
      ICPLTV=INT(PCPLTV+0.5)
      IF(ICPLTV.LT.1)ICPLTV=1
      IF(ICPLTV.GT.2)ICPLTV=2
C
      IFLAGV=ICPLRV+ICPLXV+ICPLTV+ITAG
C
      IRC1=1
      IRC2=ICPLRV
      ICOL=IRC2
      IF(ICPLXV.GE.1)ICOL=ICOL+1
      IXC1=ICOL
      IF(ICPLXV.GE.2)THEN
        ICOL=ICOL+1
        IXC2=ICOL
      ENDIF
      IF(ICPLXV.GE.3)THEN
        ICOL=ICOL+1
        IXC3=ICOL
      ENDIF
      ICOL=ICOL+1
      ICC1=ICOL
      IF(ICPLTV.EQ.2)ICOL=ICOL+1
      ICC2=ICOL
      IF(ITAG.GT.0)ICOL=ICOL+1
      ITC1=ICOL
C
C               *****************************************
C               **  TREAT THE CONDITIONING PLOT   CASE **
C               *****************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COND')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCOND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,71)ICPLLA
   71 FORMAT('ICPLLA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICPLTA
   72 FORMAT('ICPLTA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ICPLPT
   73 FORMAT('ICPLPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ICPLFI
   74 FORMAT('ICPLFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ICPLFR
   75 FORMAT('ICPLFR = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  SHIFT COMMAND LINE ARGMENTS                     **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
      ICOM='PLOT'
      ICOM2='    '
      IFOUND='YES'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINN2=2
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'COND')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXY,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 12B-                                   **
C               **  NUMBER OF VARIABLES MUST EQUAL IFLAGV       **
C               **************************************************
C
      ISTEPN='12B'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.NE.IFLAGV)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1291)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1293)ICPLRV
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1294)ICPLXV
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1295)ICPLTV
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1296)ITAG
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1297)NUMVAR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1328)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,100))
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1291 FORMAT('***** ERROR IN DPCOND--EXPECTED')
 1293 FORMAT('         ',I8,'RESPONSE VARIABLES')
 1294 FORMAT('         ',I8,'INDEPENDENT VARIABLES')
 1295 FORMAT('         ',I8,'CONDITIONING VARIABLES')
 1296 FORMAT('         ',I8,'TAG VARIABLES')
 1297 FORMAT('      DETECTED ',I8,' VARIABLES.')
C
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFLAG=0
      IFLAG2=0
      DO1300I=1,NUMVAR
C
        IHRIGH=IVARN1(I)
        IHRIG2=IVARN2(I)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLL(I)=IVALUE(ILOCV)
C
        NTEMP=IN(ILOCV)
        IF(I.EQ.1)THEN
          NRIGHT=NTEMP
        ELSEIF(I.GE.2)THEN
          NRIGH2=NTEMP
          IF(NRIGH2.NE.NRIGHT)IFLAG=1
        ENDIF
C
        IF(I.EQ.ICC1)THEN
          ICOL=IVALUE(ILOCV)
          J=0
          DO1261ITEMP=1,NRIGH2
            J=J+1
            NIN=J
            IJ=MAXN*(ICOL-1)+ITEMP
            IF(ICOL.LE.MAXCOL)TEMP(J)=V(IJ)
            IF(ICOL.EQ.MAXCP1)TEMP(J)=PRED(ITEMP)
            IF(ICOL.EQ.MAXCP2)TEMP(J)=RES(ITEMP)
            IF(ICOL.EQ.MAXCP3)TEMP(J)=YPLOT(ITEMP)
            IF(ICOL.EQ.MAXCP4)TEMP(J)=XPLOT(ITEMP)
            IF(ICOL.EQ.MAXCP5)TEMP(J)=X2PLOT(ITEMP)
            IF(ICOL.EQ.MAXCP6)TEMP(J)=TAGPLO(ITEMP)
 1261     CONTINUE
          IWRITE='OFF'
          CALL DISTIN(TEMP,NIN,IWRITE,ADIST1,NOUT,IBUGG3,IERROR)
          IF(NOUT.GT.MAXY)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1266)
 1266 FORMAT('***** ERROR IN DPCOND--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1267)NOUT
 1267 FORMAT('      NUMBER OF DISTINCT SUBSETS, ',I8,' EXCEEDS THE ')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1268)MAXY
 1268 FORMAT('      MAXIMUM ALLOWABLE OF ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
C
        IF(ICPLTV.EQ.2.AND.I.EQ.ICC2)THEN
          ICOL=IVALUE(ILOCV)
          J=0
          DO1271ITEMP=1,NRIGH2
            J=J+1
            NIN2=J
            IJ=MAXN*(ICOL-1)+ITEMP
            IF(ICOL.LE.MAXCOL)TEMP2(J)=V(IJ)
            IF(ICOL.EQ.MAXCP1)TEMP2(J)=PRED(ITEMP)
            IF(ICOL.EQ.MAXCP2)TEMP2(J)=RES(ITEMP)
            IF(ICOL.EQ.MAXCP3)TEMP2(J)=YPLOT(ITEMP)
            IF(ICOL.EQ.MAXCP4)TEMP2(J)=XPLOT(ITEMP)
            IF(ICOL.EQ.MAXCP5)TEMP2(J)=X2PLOT(ITEMP)
            IF(ICOL.EQ.MAXCP6)TEMP2(J)=TAGPLO(ITEMP)
 1271     CONTINUE
          IWRITE='OFF'
          CALL DISTIN(TEMP2,NIN2,IWRITE,ADIST2,NOUT2,IBUGG3,IERROR)
          IF(NOUT2.GT.MAXY)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1276)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1277)NOUT2
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1278)MAXY
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 1276 FORMAT('***** ERROR IN DPCOND--')
 1277 FORMAT('      NUMBER OF DISTINCT SUBSETS, ',I8,' EXCEEDS THE ')
 1278 FORMAT('      MAXIMUM ALLOWABLE OF ',I8)
C
        ILIS(I)=ILOCV
C
        IF(NTEMP.GT.MINN2)GOTO1390
C
 1309   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPCOND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1321)
 1321 FORMAT('      CONDITIONING PLOT   WAS TO HAVE BEEN FORMED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE',
     1' HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1327)I,NTEMP
 1327 FORMAT('      VARIABLE ',I8,' HAS ',I8,' OBSERVATIONS.')
        WRITE(ICOUT,1328)
 1328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,100))
 1329 FORMAT('      ',100A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
C
C               ******************************************************
C               **  STEP 1.4--                                      **
C               **  CHECK THAT VARIABLES HAVE THE SAME NUMBER OF    **
C               **  ELEMENTS.                                       **
C               ******************************************************
C
 1400 CONTINUE
      ISTEPN='1.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPCOND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      INDEPENDENT, AND TAG VARIABLES MUST BE THE SAME.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
      CALL DPWRST('XXX','BUG ')
 1415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
C
      DO1417I=1,NUMVAR
      I2=ILIS(I)
      WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
 1417 CONTINUE
      WRITE(ICOUT,1420)
 1420 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1421)(IANS(I),I=1,MIN(IWIDTH,100))
 1421 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               **************************************************
C               **   STEP 1--                                   **
C               **   SAVE INITIAL SETTINGS                      **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COND')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PXMN2=PXMIN
      PXMX2=PXMAX
      PYMN2=PYMIN
      PYMX2=PYMAX
      PWXMN2=PWXMIN
      PWXMX2=PWXMAX
      PWYMN2=PWYMIN
      PWYMX2=PWYMAX
      IF(ICPLFR.EQ.'DEFA')THEN
        PXMIN=0.0
        PXMAX=100.0
        PYMIN=0.0
        PYMAX=100.0
      ENDIF
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
C
      IERAS2=IERASW
      IPPTB2=IPPTBI
      IPPTBI='UNBI'
      IX1TSV=IX1TSW
      IX2TSV=IX2TSW
      IY1TSV=IY1TSW
      IY2TSV=IY2TSW
      IX1ZSV=IX1ZSW
      IX2ZSV=IX2ZSW
      IY1ZSV=IY1ZSW
      IY2ZSV=IY2ZSW
      PX1LD2=PX1LDS
      PX2LD2=PX2LDS
      PY1LD2=PY1LDS
      PY1LA2=PY1LAN
      IY1LJ2=IY1LJU
      IY1LD2=IY1LDI
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      GX1MNS=GX1MIN
      GX1MXS=GX1MAX
      GX2MNS=GX2MIN
      GX2MXS=GX2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IX1MNS=IX1MIN
      IX1MXS=IX1MAX
      IX2MNS=IX2MIN
      IX2MXS=IX2MAX
      IX1FSV=IX1FSW
      IX2FSV=IX2FSW
      IY1FSV=IY1FSW
      IY2FSV=IY2FSW
      PX1ZD2=PX1ZDS
      PX2ZD2=PX2ZDS
      PY1ZD2=PY1ZDS
      PY2ZD2=PY2ZDS
      ISORS2=ISORSW
C
      ICPLFZ=ICPLFR
      ICPLL2=ICPLLA
      IF(ICPLFR.EQ.'CONN')ICPLFR='DEFA'
      IF(ICPLFR.EQ.'USER'.AND.ICPLLA.EQ.'BOX')ICPLLA='ON'
      IF(ICPLLA.EQ.'BOX ')THEN
        ICPLLD='ON'
CCCCC   ICPLXA='BOTT'
CCCCC   ICPLYA='LEFT'
      ENDIF
      ICPLTZ=ICPLTA
      ICPLPZ=ICPLPT
      ICPLLZ=ICPLLD
      ICPLZT=ICPLST
      ICPLZ2=ICPLS2
      ICPLZ3=ICPLS3
      ICPLZ4=ICPLS4
      ICPLXZ=ICPLXA
      ICPLYZ=ICPLYA
      ICPLDZ=ICPLDI
C
      ILFLAX='OFF'
      ILFLAY='OFF'
      IF(IY1MIN.EQ.'FIXE'.AND.IY1MAX.EQ.'FIXE')THEN
        ILFLAY='ON'
      ENDIF
      IF(IX1MIN.EQ.'FIXE'.AND.IX2MAX.EQ.'FIXE')THEN
        ILFLAX='ON'
      ENDIF
C
      DO1495I=1,100
        ICHAP2(I)=ICHAPA(I)
        ILINP2(I)=ILINPA(I)
        IBARS2(I)=IBARSW(I)
        ISPIS2(I)=ISPISW(I)
 1495 CONTINUE
C
      DO1500I=1,MAXCH
        IX1LT2(I)=IX1LTE(I)
        IX2LT2(I)=IX2LTE(I)
        IY1LT2(I)=IY1LTE(I)
        IY2LT2(I)=IY2LTE(I)
 1500 CONTINUE
      NCX1L2=NCX1LA
      NCX2L2=NCX2LA
      NCY1L2=NCY1LA
      NCY2L2=NCY2LA
C
      IFEED9=IFEEDB
      IFLGIN='OFF'
      IFLGY='OFF'
      IFLGX='OFF'
C
      DO110I=1,MAXCH
        ITITSV(I)=ITITTE(I)
  110 CONTINUE
      NCTITS=NCTITL
      PTITDZ=PTITDS
C
      IF(ICPLTA.EQ.'ON'.AND.ICPLPT.EQ.'PLOT')THEN
        ISHIFT=ILOCQ-1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ISHIFT=NUMVAR-1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DO1509I=1,ISHIFT
          IHARG(I)=IVARN1(I)
          IHARG2(I)=IVARN2(I)
 1509   CONTINUE
        NUMVAR=NUMVAR-1
        IF(IPLTTY.EQ.'UNIV')THEN
          IF(NUMVAR.LT.1)GOTO9000
        ELSEIF(IPLTTY.EQ.'BIVA')THEN
          IF(NUMVAR.LT.2)GOTO9000
        ENDIF
        ILOCQ=ISHIFT+1
      ENDIF
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='SPMA'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')IOUNI5=0
C
      IMPSW3=IMPSW
      IMPCO2=IMPCO
      IMPNR2=IMPNR
      IMPNC2=IMPNC
      IMPSW='ON'
      IMPCO=1
C
C  DETERMINE NUMBER OF ROWS AND COLUMNS FOR PLOT.  BASED ON
C  BOTH THE NUMBER OF RESPONSE VARIABLES AND NUMBER OF DISTINCT
C  VALUES IN THE CONDITIONING VARIABLES.
C
      IF(ICPLRV.EQ.1)THEN
        IF(ICPLTV.EQ.1)THEN
          NPLOTS=NOUT
          IF(IMPNR*IMPNC.LT.NPLOTS)THEN
            IMPNC=INT(SQRT(REAL(NPLOTS-1)))+1
            IMPNR=1
            IF(NPLOTS.GE.11)THEN
              IMPNR=INT(NPLOTS/IMPNC)+1
            ELSEIF(NPLOTS.GE.7)THEN
              IMPNR=3
            ELSEIF(NPLOTS.GE.3)THEN
              IMPNR=2
            ENDIF
          ENDIF
          IFACTV=NPLOTS
        ELSE
          NPLOTS=NOUT*NOUT2
          IMPNR=NOUT
          IMPNC=NOUT2
          IFACTV=NPLOTS
        ENDIF
      ELSE
        IF(ICPLTV.EQ.1)THEN
          IMPNR=ICPLRV
          IMPNC=NOUT
          NPLOTS=IMPNR*IMPNC
          IFACTV=NOUT
        ELSE
          IMPNR=ICPLRV*NOUT
          IMPNC=NOUT2
          NPLOTS=IMPNR*IMPNC
          IFACTV=NOUT*NOUT2
        ENDIF
      ENDIF
C
      IROWT=ICPLRV
      ICOLT=IFACTV
      IF(ICPLLA.EQ.'BOX')THEN
        IMPNR=IMPNR+1
        IMPNC=IMPNC+1
        IROWT=ICPLRV+1
        ICOLT=IFACTV+1
      ENDIF
C
      IXAXIS=0
      IYAXIS=0
C
C  2-VARIABLE PLOTS
C
      IF(ICPLPT.EQ.'PLOT')THEN
        ICT='PLOT'
        IC2T='    '
        NCCOMM=0
        IPLOTT='PLOT'
        IFLGIN='NO'
        IF((IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA').OR.
     1     (IX1MIN.EQ.'FLOA'.AND.IX1MAX.EQ.'FLOA'))THEN
          IF((PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN).OR.
     1       (PCPXLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN))THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='ON'
          ENDIF
        ENDIF
        GOTO6999
      ENDIF
      IF(ICPLPT.EQ.'STAT')THEN
        ICT=ICPLST
        IC2T=ICPLS2
        NCCOMM=0
        IF(ICPLS3.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLS3
          IH2T(NCCOMM)=ICPLS4
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        IPLOTT='STAT'
        IFLGIN='NO'
        GOTO6999
      ENDIF
      IF(ICPLPT.EQ.'BIHI')THEN
        ICT='RELA'
        IC2T='TIVE'
        IHT(1)='BIHI'
        IH2T(1)='STOG'
        NCCOMM=1
        IPLOTT='BIHI'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            IRHSTG='PERC'
            GY1MIN=-0.6
            GY1MAX=0.6
            GY2MIN=-0.6
            GY2MAX=0.6
            IY1MIN='FIXE'
            IY1MAX='FIXE'
            IY2MIN='FIXE'
            IY2MAX='FIXE'
            IYAXIS=1
          ENDIF
        ENDIF
        GOTO6999
      ENDIF
C
      IF(ICPLPT.EQ.'BOXC')THEN
        ICT='BOX '
        IC2T='    '
        IHT(1)='COX '
        IH2T(1)='    '
        IHT(2)='LINE'
        IH2T(2)='ARIT'
        IHT(3)='PLOT'
        IH2T(3)='    '
        NCCOMM=3
        IPLOTT='CBXC'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            GY1MIN=-1.0
            GY1MAX=1.0
            GY2MIN=-1.0
            GY2MAX=1.0
            IY1MIN='FIXE'
            IY1MAX='FIXE'
            IY2MIN='FIXE'
            IY2MAX='FIXE'
            IYAXIS=1
          ENDIF
        ENDIF
        GOTO6999
      ENDIF
      IF(ICPLPT.EQ.'QQPL')THEN
        ICT='QUAN'
        IC2T='TILE'
        IHT(1)='QUAN'
        IH2T(1)='TILE'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='QQSP'
        IFLGIN='NO'
        IF((IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA').OR.
     1     (IX1MIN.EQ.'FLOA'.AND.IX1MAX.EQ.'FLOA'))THEN
          IF((PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN).OR.
     1       (PCPXLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN))THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='ON'
          ENDIF
        ENDIF
        GOTO6999
      ENDIF
CCCCC IF(ICPLPT.EQ.'CROS')THEN
CCCCC   GOTO7999
CCCCC ENDIF
C
C 3-D PLOTS
C
      IF(ICPLPT.EQ.'YACU')THEN
        ICT='YATE'
        IC2T='S   '
        IHT(1)='CUBE'
        IH2T(1)='    '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='YACU'
        IFLGIN='NO'
        GOTO7499
      ENDIF
      IF(ICPLPT.EQ.'3DPL')THEN
        ICT='3D  '
        IC2T='    '
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='3DPL'
        IFLGIN='NO'
        GOTO7499
      ENDIF
C
C
C  1-VARIABLE PLOTS
C
      IF(ICPLPT.EQ.'HIST')THEN
        ICT='RELA'
        IC2T='TIVE'
        IHT(1)='HIST'
        IH2T(1)='OGRA'
        NCCOMM=1
        IPLOTT='HIST'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            IRHSTG='PERC'
            GY1MIN=0.0
            GY1MAX=0.6
            GY2MIN=0.0
            GY2MAX=0.6
            IY1MIN='FIXE'
            IY1MAX='FIXE'
            IY2MIN='FIXE'
            IY2MAX='FIXE'
            IYAXIS=1
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'DENS')THEN
        ICT='KERN'
        IC2T='EL  '
        IHT(1)='DENS'
        IH2T(1)='ITY '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='CDEN'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            IRHSTG='PERC'
            GY1MIN=0.0
            GY1MAX=0.6
            GY2MIN=0.0
            GY2MAX=0.6
            IY1MIN='FIXE'
            IY1MAX='FIXE'
            IY2MIN='FIXE'
            IY2MAX='FIXE'
            IYAXIS=1
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'RUNS')THEN
        ICT='RUN '
        IC2T='    '
        IHT(1)='SEQU'
        IH2T(1)='ENCE'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='CRUN'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='OFF'
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'PERC')THEN
        ICT='PERC'
        IC2T='ENT '
        IHT(1)='POIN'
        IH2T(1)='T   '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        IPLOTT='CPER'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='OFF'
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'AUTO')THEN
        ICT='AUTO'
        IC2T='CORR'
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='CRUN'
        IFLGIN='NO'
        IF(IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA')THEN
          IF(PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN)THEN
            GY1MIN=-1.0
            GY1MAX=1.0
            GY2MIN=-1.0
            GY2MAX=1.0
            IY1MIN='FIXE'
            IY1MAX='FIXE'
            IY2MIN='FIXE'
            IY2MAX='FIXE'
            IYAXIS=1
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'SPEC')THEN
        ICT='SPEC'
        IC2T='TRAL'
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='SPEC'
        IFLGIN='NO'
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'LAG ')THEN
        ICT='LAG '
        IC2T='    '
        IHT(1)='PLOT'
        IH2T(1)='    '
        NCCOMM=1
        IPLOTT='LAG '
        IFLGIN='NO'
        IF((IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA').OR.
     1     (IX1MIN.EQ.'FLOA'.AND.IX1MAX.EQ.'FLOA'))THEN
          IF((PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN).OR.
     1       (PCPXLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN))THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='ON'
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'PROB')THEN
        ICT=ICPLP1
        IC2T='    '
        NCCOMM=0
        IF(ICPLP2.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLP2
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLP3.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLP3
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLP4.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLP4
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLP5.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLP5
          IH2T(NCCOMM)='    '
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PROB'
        IH2T(NCCOMM)='ABIL'
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        IPLOTT='PROB'
        IFLGIN='NO'
        IF((IY1MIN.EQ.'FLOA'.AND.IY1MAX.EQ.'FLOA').OR.
     1     (IX1MIN.EQ.'FLOA'.AND.IX1MAX.EQ.'FLOA'))THEN
          IF((PCPYLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN).OR.
     1       (PCPXLL(1).EQ.CPUMIN.AND.PCPYUL(1).EQ.CPUMIN))THEN
            IFLGIN='YES'
            IFLGY='ON'
            IFLGX='ON'
          ENDIF
        ENDIF
        GOTO5999
      ENDIF
      IF(ICPLPT.EQ.'PPCC')THEN
        ICT=ICPLC1
        IC2T='    '
        NCCOMM=0
        IF(ICPLC2.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLC2
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLC3.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLC3
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLC4.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLC4
          IH2T(NCCOMM)='    '
        ENDIF
        IF(ICPLC5.NE.'    ')THEN
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)=ICPLC5
          IH2T(NCCOMM)='    '
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PPCC'
        IH2T(NCCOMM)='    '
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        IPLOTT='PPCC'
        IFLGIN='NO'
        GOTO5999
      ENDIF
      GOTO8000
C
C               *******************************************
C               **   STEP 21--                           **
C               **   GENERATE THE RUN SEQUENCE    PLOTS  **
C               **   GENERATE THE HISTOGRAM       PLOTS  **
C               **   GENERATE THE PERCENTILE      PLOTS  **
C               **   GENERATE THE AUTOCORRELATION PLOTS  **
C               **   GENERATE THE SPECTRAL        PLOTS  **
C               **   GENERATE THE LAG             PLOTS  **
C               **   GENERATE THE PROBABILITY     PLOTS **
C               **   GENERATE THE PPCC            PLOTS **
C               **   GENERATE THE KERNEL DENSITY  PLOTS **
C               *******************************************
C
 5999 CONTINUE
C
C  IF NO PRIOR LIMITS SET FOR Y AXIS, USE 0 TO 0.6 (THIS MAY NOT
C  BE OPTIMAL, BUT IT WILL ALWAYS SHOW ALL THE DATA).
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=ILOCQ-1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
      IF(IERROR.EQ.'YES')GOTO8000
C
C  CREATE BASIC COMMAND LINE, FOR EXAMPLE:
C    RELATIVE HISTOGRAM Y SUBSET COND1 =  SUBSET COND2 = 
C  WHERE COND2 IS OPTIONAL
C
C  FOR SOME PLOT TYPES, NEED TO DO AN INITIAL PLOT TO SET PLOT LIMITS
C
      ISHIFT=NCCOMM+1
      IF(ICPLTV.GE.1)ISHIFT=ISHIFT+4
      IF(ICPLTV.GE.2)ISHIFT=ISHIFT+4
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      DO6006II=1,NCCOMM
        IHARG(II)=IHT(II)
        IHARG2(II)=IH2T(II)
        IARGT(II)='WORD'
 6006 CONTINUE
      NWORD=NCCOMM+1
      NPOS=NWORD
      IHARG(NWORD)=IVARN1(1)
      IHARG2(NWORD)=IVARN2(1)
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='SUBS'
      IHARG2(NWORD)='ET  '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)=IVARN1(ICC1)
      IHARG2(NWORD)=IVARN2(ICC1)
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='=   '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='0  '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='NUMB'
      NPOS1=NWORD
C
      IF(ICPLTV.EQ.2)THEN
        NWORD=NWORD+1
        IHARG(NWORD)='SUBS'
        IHARG2(NWORD)='ET  '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)=IVARN1(ICC2)
        IHARG2(NWORD)=IVARN2(ICC2)
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='=   '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='0  '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='NUMB'
        NPOS2=NWORD
      ENDIF
      NARGT=NUMARG
C
      DO6020I=1,NARGT
        IHT(I)=IHARG(I)
        IH2T(I)=IHARG2(I)
        IARGTT(I)=IARGT(I)
        ARGT(I)=ARG(I)
 6020 CONTINUE
C
      IPLOT=0
      DO6200IRES=1,IROWT
C
C  CREATE INITIAL PLOT TO DETERMINE SCALE
C
      IF(IFLGIN.EQ.'YES')THEN
        ISHIFT=NWORD
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ISHIFT=NCCOMM+1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ICOM=ICT
        ICOM2=IC2T
        DO6210II=1,NCCOMM
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)='WORD'
 6210   CONTINUE
        NTEMP=NCCOMM+1
        IHARG(NTEMP)=IVARN1(IRES)
        IHARG2(NTEMP)=IVARN2(IRES)
        IARGT(NTEMP)='WORD'
C
C  GENERATE THE DUMMY PLOT
C
        ICHAPA(1)='BLAN'
        ILINPA(1)='BLAN'
        IBARSW(1)='OFF'
        ISPISW(1)='OFF'
C
        GY1MIN=CPUMIN
        GY1MAX=CPUMAX
        GY2MIN=CPUMIN
        GY2MAX=CPUMAX
        GX1MIN=CPUMIN
        GX1MAX=CPUMAX
        GX2MIN=CPUMIN
        GX2MAX=CPUMAX
        IY1MIN='FLOA'
        IY1MAX='FLOA'
        IY2MIN='FLOA'
        IY2MAX='FLOA'
        IX1MIN='FLOA'
        IX1MAX='FLOA'
        IX2MIN='FLOA'
        IX2MAX='FLOA'
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
C
        IX1TSW='OFF'
        IX1ZSW='OFF'
        IX2TSW='OFF'
        IX2ZSW='OFF'
        IY1TSW='OFF'
        IY1ZSW='OFF'
        IY2TSW='OFF'
        IY2ZSW='OFF'
        IX1FSW='OFF'
        IX2FSW='OFF'
        IY1FSW='OFF'
        IY2FSW='OFF'
        IERASW='ON'
        DO6250I=1,MAXCH
          IX1LTE(I)='    '
          IX2LTE(I)='    '
          IY1LTE(I)='    '
          IY2LTE(I)='    '
 6250   CONTINUE
        NCX1LA=0
        NCX2LA=0
        NCY1LA=0
        NCY2LA=0
        NCTITL=0
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        IMPCO=IMPCO-1
        IF(IFLGY.EQ.'ON')THEN
          GY1MIN=FY1MNZ
          GY1MAX=FY1MXZ
          GY2MIN=FY2MNZ
          GY2MAX=FY2MXZ
          IY1MIN='FIXE'
          IY1MAX='FIXE'
          IY2MIN='FIXE'
          IY2MAX='FIXE'
        ELSE
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
        ENDIF
        IF(IFLGX.EQ.'ON')THEN
          GX1MIN=FX1MNZ
          GX1MAX=FX1MXZ
          GX2MIN=FX2MNZ
          GX2MAX=FX2MXZ
          IX1MIN='FIXE'
          IX1MAX='FIXE'
          IX2MIN='FIXE'
          IX2MAX='FIXE'
        ELSE
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
        ENDIF
C
        IX1TSW=IX1TSV
        IX1ZSW=IX1ZSV
        IX2TSW=IX2TSV
        IX2ZSW=IX2ZSV
        IY1TSW=IY1TSV
        IY1ZSW=IY1ZSV
        IY2TSW=IY2TSV
        IY2ZSW=IY2ZSV
        IX1FSW=IX1FSV
        IX2FSW=IX2FSV
        IY1FSW=IY1FSV
        IY2FSW=IY2FSV
        IERASW='OFF'
C
C  RESTORE COMMAND LINE
C
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        DO6220II=1,NARGT
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)=IARGTT(II)
          ARG(II)=ARGT(II)
 6220   CONTINUE
      ENDIF
C
      DO6100IFAC=1,ICOLT
C
        IPLOT=IPLOT+1
        IX=IXC1
        IXLIST=1
        IROW=INT(IPLOT/IMPNC)+1
        IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
        ICOL=MOD(IPLOT,IMPNC)
        IF(ICOL.EQ.0)ICOL=IMPNC
C
        IHARG(NPOS)=IVARN1(IRES)
        IHARG2(NPOS)=IVARN2(IRES)
C
        IEMPTY='NO'
        IF(ICPLLA.EQ.'BOX')THEN
          ICOL=ICOL-1
          IF(ICOL.EQ.0)IEMPTY='YES'
          IF(IROW.EQ.IMPNR)IEMPTY='YES'
        ENDIF
C
        IF(ICPLRV.EQ.1)THEN
          IF(ICPLTV.EQ.1)THEN
            ARG(NPOS1)=ADIST1(IFAC)
          ELSE
            ARG(NPOS1)=ADIST1(IROW)
            ARG(NPOS2)=ADIST2(ICOL)
          ENDIF
        ELSE
          IF(ICPLTV.EQ.1)THEN
            ARG(NPOS1)=ADIST1(IFAC)
          ELSE
            ARG(NPOS1)=ADIST1(MOD(IROW-1,ICPLRV)+1)
            ARG(NPOS2)=ADIST2(ICOL)
          ENDIF
        ENDIF
C
        IF(IEMPTY.EQ.'YES')THEN
          DO6104I=1,MAXSUB
            ISU2SW(I)=ISUBSW(I)
            ISUBSW(I)='OFF'
 6104     CONTINUE
        ENDIF
        ICASPL='COND'
        IOPTN=3
        IDY=IRES
        IDX=1
        CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1              ISUBNU,ISUBSW,
     1              ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1              ISUBN9,ISUBSZ,
     1              ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1              PCPXSL,PCPXSU,PCPYSL,PCPYSU,
     1              IBUGG2,ISUBRO,IERROR)
C
        CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1              IMPNR,IMPNC,IROW,ICOL,IRES,IX,IPLOT,
     1              NPLOTS,NUMVAR,
     1              ICHAP2,ILINP2,
     1              GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1              GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1              IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1              IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              PX1LD2,PX2LD2,
     1              IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1              IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1              NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1              PCPXLL,PCPXUL,PCPYLL,PCPYUL,IXLIST,
     1              ICPLLA,ISPMLD,IPLOTT,ICPLFR,ICPLXA,ICPLYA,
     1              ISPMDI,
     1              ICPLTD,PCPLTD,IVNMEX,
     1              IBUGG2,ISUBRO)
C
CCCCC   ITITTE(1)='S'
CCCCC   ITITTE(2)='U'
CCCCC   ITITTE(3)='B'
CCCCC   ITITTE(4)='S'
CCCCC   ITITTE(5)='E'
CCCCC   ITITTE(6)='T'
CCCCC   ITITTE(7)=' '
CCCCC   NCTEMP=7
        NCTEMP=0
        DO6161I=1,4
          IF(IVARN1(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC1)(I:I)
          ENDIF
 6161   CONTINUE
        DO6163I=1,4
          IF(IVARN2(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC1)(I:I)
          ENDIF
 6163   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS1)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
        IF(ICPLTV.EQ.1)GOTO6189
        DO6169I=1,15
          NCTEMP=NCTEMP+1
          ITITTE(NCTEMP)=' '
 6169   CONTINUE
        DO6171I=1,4
          IF(IVARN1(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC2)(I:I)
          ENDIF
 6171   CONTINUE
        DO6173I=1,4
          IF(IVARN2(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC2)(I:I)
          ENDIF
 6173   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS2)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
 6189   CONTINUE
        NCTITL=NCTEMP
        IF(ICPLFR.EQ.'DEFA')THEN
          PTITDS=-ABS(PTITDZ)
        ENDIF
C
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
        IF(IEMPTY.EQ.'NO')THEN
          CALL DPSPM3(ICASPL,IOUNI5,
     1                IROW,ICOL,
     1                PX2LD2,NPLOTP,
     1                IFORSW,
     1                IFPX2L,ISPX2P,ISPX2S,
     1                IHRIGH,IHRIG2,IHWUSE,
     1                ISUBN1,ISUBN2,MESSAG,
     1                IBUGG2,ISUBRO,IERROR)
        ENDIF
C
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        IF(IERROR.EQ.'YES')GOTO6199
C
        IF(ICPLPT.NE.'PLOT')GOTO6199
        IF(ICPLFI.EQ.'NONE')GOTO6199
        IF(IEMPTY.EQ.'YES')GOTO6199
C
        IMPCO=IMPCO-1
        IF(IMPCO.LE.1)IERASW='OFF'
C
C  NOTE: NO FITTING DONE SINCE ONLY ONE VARIABLE PLOTTED
C        HERE.
C
 6199   CONTINUE
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        ICOM=ICT
        ICOM2=IC2T
        DO6101II=1,NARGT
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)=IARGTT(II)
          ARG(II)=ARGT(II)
 6101   CONTINUE
C
        PX1LDS=PX1LD2
        IF(IYAXIS.EQ.0.AND.IFLGIN.EQ.'NO')THEN
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
        ENDIF
        IF(IXAXIS.EQ.0.AND.IFLGIN.EQ.'NO')THEN
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
        ENDIF
        PX1ZDS=PX1ZD2
        PX2ZDS=PX2ZD2
        PY1ZDS=PY1ZD2
        PY2ZDS=PY2ZD2
        IF(IEMPTY.EQ.'YES')THEN
          DO6107I=1,MAXSUB
            ISUBSW(I)=ISU2SW(I)
 6107     CONTINUE
        ENDIF
        DO6108I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 6108     CONTINUE
C
 6100 CONTINUE
 6200 CONTINUE
      IF(IYAXIS.EQ.1)THEN
        GY1MIN=GY1MNS
        GY1MAX=GY1MXS
        GY2MIN=GY2MNS
        GY2MAX=GY2MXS
        IY1MIN=IY1MNS
        IY1MAX=IY1MXS
        IY2MIN=IY2MNS
        IY2MAX=IY2MXS
      ENDIF
      IF(IXAXIS.EQ.1)THEN
        GX1MIN=GX1MNS
        GX1MAX=GX1MXS
        GX2MIN=GX2MNS
        GX2MAX=GX2MXS
        IX1MIN=IX1MNS
        IX1MAX=IX1MXS
        IX2MIN=IX2MNS
        IX2MAX=IX2MXS
      ENDIF
      GOTO8000
C
C               **********************************************
C               **   STEP 21--                              **
C               **   GENERATE THE PLOT               PLOTS  **
C               **   GENERATE THE BIHISTOGRAM        PLOTS  **
C               **   GENERATE THE QUANTILE-QUANTILE  PLOTS  **
C               **   GENERATE THE BOX-COX LINEARITY  PLOTS  **
C               **   GENERATE THE STATISTIC       PLOTS     **
C               **   GENERATE THE CROSS-TABULATE  PLOTS     **
C               **********************************************
C
 6999 CONTINUE
C
C  IF NO PRIOR LIMITS SET FOR Y AXIS, USE 0 TO 0.6 (THIS MAY NOT
C  BE OPTIMAL, BUT IT WILL ALWAYS SHOW ALL THE DATA).
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=ILOCQ-1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
      IF(IERROR.EQ.'YES')GOTO8000
C
C  CREATE BASIC COMMAND LINE, FOR EXAMPLE:
C    RELATIVE BIHISTOGRAM Y1 Y2 SUBSET COND1 =  SUBSET COND2 = 
C  WHERE COND2 IS OPTIONAL
C
C  FOR SOME PLOT TYPES, NEED TO DO AN INITIAL PLOT TO SET PLOT LIMITS
C
      ISHIFT=NCCOMM+2
      IF(ICPLTV.GE.1)ISHIFT=ISHIFT+4
      IF(ICPLTV.GE.2)ISHIFT=ISHIFT+4
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      DO7006II=1,NCCOMM
        IHARG(II)=IHT(II)
        IHARG2(II)=IH2T(II)
        IARGT(II)='WORD'
 7006 CONTINUE
      NWORD=NCCOMM+1
      NPOSA=NWORD
      IHARG(NWORD)=IVARN1(1)
      IHARG2(NWORD)=IVARN2(1)
      IARGT(NWORD)='WORD'
      NWORD=NCCOMM+2
      NPOSB=NWORD
      IHARG(NWORD)=IVARN1(IXC1)
      IHARG2(NWORD)=IVARN2(IXC1)
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='SUBS'
      IHARG2(NWORD)='ET  '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)=IVARN1(ICC1)
      IHARG2(NWORD)=IVARN2(ICC1)
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='=   '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='0  '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='NUMB'
      NPOS1=NWORD
C
      IF(ICPLTV.EQ.2)THEN
        NWORD=NWORD+1
        IHARG(NWORD)='SUBS'
        IHARG2(NWORD)='ET  '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)=IVARN1(ICC2)
        IHARG2(NWORD)=IVARN2(ICC2)
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='=   '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='0  '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='NUMB'
        NPOS2=NWORD
      ENDIF
      NARGT=NUMARG
C
      DO7020I=1,NARGT
        IHT(I)=IHARG(I)
        IH2T(I)=IHARG2(I)
        IARGTT(I)=IARGT(I)
        ARGT(I)=ARG(I)
 7020 CONTINUE
C
      IPLOT=0
      DO7200IRES=1,IROWT
C
C  CREATE INITIAL PLOT TO DETERMINE SCALE
C
      IF(IFLGIN.EQ.'YES')THEN
        ISHIFT=NWORD
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ISHIFT=NCCOMM+2
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ICOM=ICT
        ICOM2=IC2T
        DO7210II=1,NCCOMM+2
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)='WORD'
 7210   CONTINUE
        NTEMP=NCCOMM+1
        IHARG(NTEMP)=IVARN1(IRES)
        IHARG2(NTEMP)=IVARN2(IRES)
        IARGT(NTEMP)='WORD'
C
C  GENERATE THE DUMMY PLOT
C
        ICHAPA(1)='BLAN'
        ILINPA(1)='BLAN'
        IBARSW(1)='OFF'
        ISPISW(1)='OFF'
        GY1MIN=CPUMIN
        GY1MAX=CPUMAX
        GY2MIN=CPUMIN
        GY2MAX=CPUMAX
        GX1MIN=CPUMIN
        GX1MAX=CPUMAX
        GX2MIN=CPUMIN
        GX2MAX=CPUMAX
        IY1MIN='FLOA'
        IY1MAX='FLOA'
        IY2MIN='FLOA'
        IY2MAX='FLOA'
        IX1MIN='FLOA'
        IX1MAX='FLOA'
        IX2MIN='FLOA'
        IX2MAX='FLOA'
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
C
        IX1TSW='OFF'
        IX1ZSW='OFF'
        IX2TSW='OFF'
        IX2ZSW='OFF'
        IY1TSW='OFF'
        IY1ZSW='OFF'
        IY2TSW='OFF'
        IY2ZSW='OFF'
        IX1FSW='OFF'
        IX2FSW='OFF'
        IY1FSW='OFF'
        IY2FSW='OFF'
        IERASW='ON'
        DO7250I=1,MAXCH
          IX1LTE(I)='    '
          IX2LTE(I)='    '
          IY1LTE(I)='    '
          IY2LTE(I)='    '
 7250   CONTINUE
        NCX1LA=0
        NCX2LA=0
        NCY1LA=0
        NCY2LA=0
        NCTITL=0
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        IMPCO=IMPCO-1
        IF(IFLGY.EQ.'ON')THEN
          GY1MIN=FY1MNZ
          GY1MAX=FY1MXZ
          GY2MIN=FY2MNZ
          GY2MAX=FY2MXZ
          IY1MIN='FIXE'
          IY1MAX='FIXE'
          IY2MIN='FIXE'
          IY2MAX='FIXE'
        ELSE
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
        ENDIF
        IF(IFLGX.EQ.'ON')THEN
          GX1MIN=FX1MNZ
          GX1MAX=FX1MXZ
          GX2MIN=FX2MNZ
          GX2MAX=FX2MXZ
          IX1MIN='FIXE'
          IX1MAX='FIXE'
          IX2MIN='FIXE'
          IX2MAX='FIXE'
        ELSE
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
        ENDIF
C
        IX1TSW=IX1TSV
        IX1ZSW=IX1ZSV
        IX2TSW=IX2TSV
        IX2ZSW=IX2ZSV
        IY1TSW=IY1TSV
        IY1ZSW=IY1ZSV
        IY2TSW=IY2TSV
        IY2ZSW=IY2ZSV
        IX1FSW=IX1FSV
        IX2FSW=IX2FSV
        IY1FSW=IY1FSV
        IY2FSW=IY2FSV
        IERASW='OFF'
C
C  RESTORE COMMAND LINE
C
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        DO7220II=1,NARGT
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)=IARGTT(II)
          ARG(II)=ARGT(II)
 7220   CONTINUE
      ENDIF
C
      DO7100IFAC=1,ICOLT
C
        IPLOT=IPLOT+1
        IX=IXC1
        IXLIST=1
        IROW=INT(IPLOT/IMPNC)+1
        IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
        ICOL=MOD(IPLOT,IMPNC)
        IF(ICOL.EQ.0)ICOL=IMPNC
C
        IHARG(NPOSA)=IVARN1(IRES)
        IHARG2(NPOSA)=IVARN2(IRES)
C
        IEMPTY='NO'
        ITEMP=IFAC
        IF(ICPLLA.EQ.'BOX')THEN
          ICOL=ICOL-1
          ITEMP=IFAC-1
          IF(ITEMP.EQ.0)IEMPTY='YES'
          IF(IROW.EQ.IMPNR)IEMPTY='YES'
        ENDIF
C
        IF(ICPLRV.EQ.1)THEN
          IF(ICPLTV.EQ.1)THEN
            IF(ITEMP.GT.0)THEN
              ARG(NPOS1)=ADIST1(ITEMP)
            ELSE
              ARG(NPOS1)=ADIST1(1)
            ENDIF
          ELSE
            IJUNK=IROW
            IF(IJUNK.GT.NOUT)IJUNK=NOUT
            IF(IJUNK.LT.1)IJUNK=1
            ARG(NPOS1)=ADIST1(IJUNK)
            IJUNK=ICOL
            IF(IJUNK.GT.NOUT2)IJUNK=NOUT2
            IF(IJUNK.LT.1)IJUNK=1
            ARG(NPOS2)=ADIST2(IJUNK)
          ENDIF
        ELSE
          IF(ICPLTV.EQ.1)THEN
            IJUNK=ITEMP
            IF(IJUNK.LT.1)IJUNK=1
            IF(IJUNK.GT.NOUT)IJUNK=NOUT
            ARG(NPOS1)=ADIST1(IJUNK)
          ELSE
            IJUNK=MOD(IROW-1,ICPLRV)+1
            IF(IJUNK.LT.1)IJUNK=1
            IF(IJUNK.GT.NOUT)IJUNK=NOUT
            ARG(NPOS1)=ADIST1(IJUNK)
            IJUNK=ITEMP
            IF(IJUNK.GT.NOUT2)IJUNK=NOUT2
            IF(IJUNK.LT.1)IJUNK=1
            ARG(NPOS2)=ADIST2(IJUNK)
          ENDIF
        ENDIF
C
        IF(IEMPTY.EQ.'YES')THEN
          DO7104I=1,MAXSUB
            ISU2SW(I)=ISUBSW(I)
            ISUBSW(I)='OFF'
 7104     CONTINUE
        ENDIF
        ICASPL='COND'
        IOPTN=3
        IDY=IRES
        IDX=1
        CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1              ISUBNU,ISUBSW,
     1              ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1              ISUBN9,ISUBSZ,
     1              ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1              PCPXSL,PCPXSU,PCPYSL,PCPYSU,
     1              IBUGG2,ISUBRO,IERROR)
C
        CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1              IMPNR,IMPNC,IROW,ICOL,IRES,IX,IPLOT,
     1              NPLOTS,NUMVAR,
     1              ICHAP2,ILINP2,
     1              GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1              GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1              IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1              IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              PX1LD2,PX2LD2,
     1              IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1              IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1              NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1              PCPXLL,PCPXUL,PCPYLL,PCPYUL,IXLIST,
     1              ICPLLA,ISPMLD,IPLOTT,ICPLFR,ICPLXA,ICPLYA,
     1              ISPMDI,
     1              ICPLTD,PCPLTD,IVNMEX,
     1              IBUGG2,ISUBRO)
C
CCCCC   ITITTE(1)='S'
CCCCC   ITITTE(2)='U'
CCCCC   ITITTE(3)='B'
CCCCC   ITITTE(4)='S'
CCCCC   ITITTE(5)='E'
CCCCC   ITITTE(6)='T'
CCCCC   ITITTE(7)=' '
CCCCC   NCTEMP=7
        NCTEMP=0
        DO7161I=1,4
          IF(IVARN1(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC1)(I:I)
          ENDIF
 7161   CONTINUE
        DO7163I=1,4
          IF(IVARN2(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC1)(I:I)
          ENDIF
 7163   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS1)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
        IF(ICPLTV.EQ.1)GOTO7189
        DO7169I=1,15
          NCTEMP=NCTEMP+1
          ITITTE(NCTEMP)=' '
 7169   CONTINUE
        DO7171I=1,4
          IF(IVARN1(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC2)(I:I)
          ENDIF
 7171   CONTINUE
        DO7173I=1,4
          IF(IVARN2(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC2)(I:I)
          ENDIF
 7173   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS2)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
 7189   CONTINUE
        NCTITL=NCTEMP
        IF(ICPLFR.EQ.'DEFA')THEN
          PTITDS=-ABS(PTITDZ)
        ENDIF
        IF(IEMPTY.EQ.'YES')THEN
          DO5306I=1,100
            ICHAPA(I)='BLAN'
            ILINPA(I)='BLAN'
            ISPISW(I)='OFF'
            IBARSW(I)='OFF'
 5306     CONTINUE
          NCTITL=0
        ENDIF
C
C
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
        IF(IEMPTY.EQ.'NO')THEN
          CALL DPSPM3(ICASPL,IOUNI5,
     1                IROW,ICOL,
     1                PX2LD2,NPLOTP,
     1                IFORSW,
     1                IFPX2L,ISPX2P,ISPX2S,
     1                IHRIGH,IHRIG2,IHWUSE,
     1                ISUBN1,ISUBN2,MESSAG,
     1                IBUGG2,ISUBRO,IERROR)
        ENDIF
C
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        IF(IERROR.EQ.'YES')GOTO7199
C
        IF(ICPLPT.NE.'PLOT')GOTO7199
        IF(ICPLFI.EQ.'NONE')GOTO7199
        IF(IEMPTY.EQ.'YES')GOTO7199
C
        IMPCO=IMPCO-1
        IF(IMPCO.LE.1)IERASW='OFF'
C
        CALL DPSPM2(ICASPL,IVARN1,IVARN2,ICOLL,NUMVAR,NPLOTP,
     1              IRES,IX,ICHAP2,ILINP2,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ALOWFR,ALOWDG,
     1              IANGLU,MAXNPP,IAND1,IAND2,
     1              ICPLFI,ICPLTA,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IREPCH,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,
     1              ISUBRO,IFOUND,IERROR)
        IF(IERROR.EQ.'YES')GOTO7199
C
 7199   CONTINUE
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        ICOM=ICT
        ICOM2=IC2T
        DO7101II=1,NARGT
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)=IARGTT(II)
          ARG(II)=ARGT(II)
 7101   CONTINUE
C
        PX1LDS=PX1LD2
        IF(IYAXIS.EQ.0.AND.IFLGIN.EQ.'NO')THEN
          GY1MNS=GY1MIN
          GY1MXS=GY1MAX
          GY2MNS=GY2MIN
          GY2MXS=GY2MAX
          IY1MNS=IY1MIN
          IY1MXS=IY1MAX
          IY2MNS=IY2MIN
          IY2MXS=IY2MAX
        ENDIF
        IF(IXAXIS.EQ.0.AND.IFLGIN.EQ.'NO')THEN
          GX1MNS=GX1MIN
          GX1MXS=GX1MAX
          GX2MNS=GX2MIN
          GX2MXS=GX2MAX
          IX1MNS=IX1MIN
          IX1MXS=IX1MAX
          IX2MNS=IX2MIN
          IX2MXS=IX2MAX
        ENDIF
        PX1ZDS=PX1ZD2
        PX2ZDS=PX2ZD2
        PY1ZDS=PY1ZD2
        PY2ZDS=PY2ZD2
        IF(IEMPTY.EQ.'YES')THEN
          DO7107I=1,MAXSUB
            ISUBSW(I)=ISU2SW(I)
 7107     CONTINUE
        ENDIF
        DO7108I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 7108     CONTINUE
C
 7100 CONTINUE
 7200 CONTINUE
      IF(IYAXIS.EQ.1)THEN
        GY1MIN=GY1MNS
        GY1MAX=GY1MXS
        GY2MIN=GY2MNS
        GY2MAX=GY2MXS
        IY1MIN=IY1MNS
        IY1MAX=IY1MXS
        IY2MIN=IY2MNS
        IY2MAX=IY2MXS
      ENDIF
      IF(IXAXIS.EQ.1)THEN
        GX1MIN=GX1MNS
        GX1MAX=GX1MXS
        GX2MIN=GX2MNS
        GX2MAX=GX2MXS
        IX1MIN=IX1MNS
        IX1MAX=IX1MXS
        IX2MIN=IX2MNS
        IX2MAX=IX2MXS
      ENDIF
      GOTO8000
C
C               **********************************************
C               **   STEP 21--                              **
C               **   GENERATE THE 3D                 PLOTS  **
C               **   GENERATE THE YATES CUBE         PLOTS  **
C               **********************************************
C
 7499 CONTINUE
C
      IF(NPLOTS.LT.1)GOTO8000
C
      ISHIFT=ILOCQ-1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
      IF(IERROR.EQ.'YES')GOTO8000
C
C  CREATE BASIC COMMAND LINE, FOR EXAMPLE:
C    YATES CUBE PLOT Y X1 X2 X3 SUBSET COND1 =  SUBSET COND2 = 
C  WHERE COND2 IS OPTIONAL
C
      ISHIFT=NCCOMM+4
      IF(ICPLTV.GE.1)ISHIFT=ISHIFT+4
      IF(ICPLTV.GE.2)ISHIFT=ISHIFT+4
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ICOM=ICT
      ICOM2=IC2T
      DO7506II=1,NCCOMM
        IHARG(II)=IHT(II)
        IHARG2(II)=IH2T(II)
        IARGT(II)='WORD'
 7506 CONTINUE
      NWORD=NCCOMM+1
      NPOSA=NWORD
      IHARG(NWORD)=IVARN1(1)
      IHARG2(NWORD)=IVARN2(1)
      IARGT(NWORD)='WORD'
      NWORD=NCCOMM+2
      NPOSB=NWORD
      IHARG(NWORD)=IVARN1(IXC1)
      IHARG2(NWORD)=IVARN2(IXC1)
      IARGT(NWORD)='WORD'
C
      IF(ICPLXV.GE.2)THEN
        NWORD=NWORD+1
        IHARG(NWORD)=IVARN1(IXC2)
        IHARG2(NWORD)=IVARN2(IXC2)
        IARGT(NWORD)='WORD'
      ENDIF
C
      IF(ICPLXV.GE.3)THEN
        NWORD=NWORD+1
        IHARG(NWORD)=IVARN1(IXC3)
        IHARG2(NWORD)=IVARN2(IXC3)
        IARGT(NWORD)='WORD'
      ENDIF
C
      NWORD=NWORD+1
      IHARG(NWORD)='SUBS'
      IHARG2(NWORD)='ET  '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)=IVARN1(ICC1)
      IHARG2(NWORD)=IVARN2(ICC1)
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='=   '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='WORD'
C
      NWORD=NWORD+1
      IHARG(NWORD)='0  '
      IHARG2(NWORD)='    '
      IARGT(NWORD)='NUMB'
      NPOS1=NWORD
C
      IF(ICPLTV.EQ.2)THEN
        NWORD=NWORD+1
        IHARG(NWORD)='SUBS'
        IHARG2(NWORD)='ET  '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)=IVARN1(ICC2)
        IHARG2(NWORD)=IVARN2(ICC2)
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='=   '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='WORD'
C
        NWORD=NWORD+1
        IHARG(NWORD)='0  '
        IHARG2(NWORD)='    '
        IARGT(NWORD)='NUMB'
        NPOS2=NWORD
      ENDIF
      NARGT=NUMARG
C
      DO7520I=1,NARGT
        IHT(I)=IHARG(I)
        IH2T(I)=IHARG2(I)
        IARGTT(I)=IARGT(I)
        ARGT(I)=ARG(I)
 7520 CONTINUE
C
      IPLOT=0
      IEMPTY='NO'
      DO7700IRES=1,IROWT
      DO7600IFAC=1,ICOLT
C
        IPLOT=IPLOT+1
        IX=IXC1
        IXLIST=1
        IROW=INT(IPLOT/IMPNC)+1
        IF(MOD(IPLOT,IMPNC).EQ.0)IROW=IROW-1
        ICOL=MOD(IPLOT,IMPNC)
        IF(ICOL.EQ.0)ICOL=IMPNC
C
        IHARG(NPOSA)=IVARN1(IRES)
        IHARG2(NPOSA)=IVARN2(IRES)
C
        IEMPTY='NO'
        ITEMP=IFAC
C
        IF(ICPLTV.EQ.1)THEN
          IF(ITEMP.GT.0)THEN
            ARG(NPOS1)=ADIST1(ITEMP)
          ELSE
            ARG(NPOS1)=ADIST1(1)
          ENDIF
        ELSE
          IJUNK=IROW
          IF(IJUNK.GT.NOUT)IJUNK=NOUT
          IF(IJUNK.LT.1)IJUNK=1
          ARG(NPOS1)=ADIST1(IJUNK)
          IJUNK=ICOL
          IF(IJUNK.GT.NOUT2)IJUNK=NOUT2
          IF(IJUNK.LT.1)IJUNK=1
          ARG(NPOS2)=ADIST2(IJUNK)
        ENDIF
C
        ICASPL='COND'
        NCTEMP=0
        DO7661I=1,4
          IF(IVARN1(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC1)(I:I)
          ENDIF
 7661   CONTINUE
        DO7663I=1,4
          IF(IVARN2(ICC1)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC1)(I:I)
          ENDIF
 7663   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS1)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
        IF(ICPLTV.EQ.1)GOTO7689
        DO7669I=1,15
          NCTEMP=NCTEMP+1
          ITITTE(NCTEMP)=' '
 7669   CONTINUE
        DO7671I=1,4
          IF(IVARN1(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN1(ICC2)(I:I)
          ENDIF
 7671   CONTINUE
        DO7673I=1,4
          IF(IVARN2(ICC2)(I:I).NE.' ')THEN
            NCTEMP=NCTEMP+1
            ITITTE(NCTEMP)=IVARN2(ICC2)(I:I)
          ENDIF
 7673   CONTINUE
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)='='
        NCTEMP=NCTEMP+1
        ITITTE(NCTEMP)=' '
        NCTEMP=NCTEMP+1
        VAL=ARG(NPOS2)
        IVAL=INT(VAL+0.5)
        IF(VAL.LT.0.0)IVAL=INT(VAL-0.5)
        CALL DPCONH(IVAL,VAL,ITITTE(NCTEMP),NH,IBUGG2,IERROR)
        NCTEMP=NCTEMP+NH-1
 7689   CONTINUE
        NCTITL=NCTEMP
        IF(ICPLFR.EQ.'DEFA')THEN
          PTITDS=-ABS(PTITDZ)
        ENDIF
C
        CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1              MAXNPP,ISEED,IBOOSS,
     1              IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1              IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1              BARHEF,BARWEF,
     1              IRHSTG,IHSTCW,
     1              ICAPSW,IFORSW,
     1              IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1              TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1              ISUBRO,IFOUND,IERROR)
C
        ICONT=IDCONT(1)
        NUMHPP=IDNHPP(1)
        IMPARG=2
        CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1              XMATN,YMATN,XMITN,YMITN,
     1              ISQUAR,
     1              IVGMSW,IHGMSW,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1              IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1              YPLOT,XPLOT,X2PLOT,TAGPLO,
     1              IMPSW,IMPNR,IMPNC,IMPCO,
     1              IMPARG,
     1              PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1              MAXCOL,
     1              DSIZE,DSYMB,DCOLOR,DFILL,
     1              ICAPSW,
     1              IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1              IERROR)
        IF(IERROR.EQ.'NO')IAND1=IAND2
        IF(IERROR.EQ.'YES')GOTO7699
C
 7699   CONTINUE
        ISHIFT=NARGT-NUMARG
        IF(ISHIFT.GT.0)THEN
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ELSEIF(ISHIFT.LT.0)THEN
          ISHIFT=-ISHIFT
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
        ENDIF
        ICOM=ICT
        ICOM2=IC2T
        DO7601II=1,NARGT
          IHARG(II)=IHT(II)
          IHARG2(II)=IH2T(II)
          IARGT(II)=IARGTT(II)
          ARG(II)=ARGT(II)
 7601   CONTINUE
C
 7600 CONTINUE
 7700 CONTINUE
      GOTO8000
C
C               **************************************************
C               **   STEP 28--                                  **
C               **   REINSTATE INITIAL SETTINGS                 **
C               **************************************************
C
 8000 CONTINUE
 2800 CONTINUE
      ISTEPN='28'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,8807)IMANUF,NUMDEV,IDMANU(1)
 8807 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      PWXMIN=PWXMN2
      PWXMAX=PWXMX2
      PWYMIN=PWYMN2
      PWYMAX=PWYMX2
      PXMIN=PXMN2
      PXMAX=PXMX2
      PYMIN=PYMN2
      PYMAX=PYMX2
C
      DO8820I=1,100
        ICHAPA(I)=ICHAP2(I)
        ILINPA(I)=ILINP2(I)
        IBARSW(I)=IBARS2(I)
        ISPISW(I)=ISPIS2(I)
 8820 CONTINUE
C
CCCCC IMPSW=IMPSW3
      IMPSW='OFF'
      IMPCO=1
      IMPNR=IMPNR2
      IMPNC=IMPNC2
C
      IERASW='ON'
      IX1TSW=IX1TSV
      IX2TSW=IX2TSV
      IY1TSW=IY1TSV
      IY2TSW=IY2TSV
      IX1ZSW=IX1ZSV
      IX2ZSW=IX2ZSV
      IY1ZSW=IY1ZSV
      IY2ZSW=IY2ZSV
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      GX1MIN=GX1MNS
      GX1MAX=GX1MXS
      GX2MIN=GX2MNS
      GX2MAX=GX2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
      IX1MIN=IX1MNS
      IX1MAX=IX1MXS
      IX2MIN=IX2MNS
      IX2MAX=IX2MXS
      PX1ZDS=PX1ZD2
      PX2ZDS=PX2ZD2
      PY1ZDS=PY1ZD2
      PY2ZDS=PY2ZD2
      ISORSW=ISORS2
      IPPTBI=IPPTB2
C
      ICPLFR=ICPLFZ
C
      DO8500I=1,MAXCH
        IX1LTE(I)=IX1LT2(I)
        IX2LTE(I)=IX2LT2(I)
        IY1LTE(I)=IY1LT2(I)
        IY2LTE(I)=IY2LT2(I)
 8500 CONTINUE
      NCX1LA=NCX1L2
      NCX2LA=NCX2L2
      NCY1LA=NCY1L2
      NCY2LA=NCY2L2
C
      IFEEDB=IFEED9
C
      DO8809I=1,MAXCH
        ITITTE(I)=ITITSV(I)
 8809 CONTINUE
      NCTITL=NCTITS
      PTITDS=PTITDZ
C
      IENDF5='OFF'
      IREWI5='ON'
      IF(IOUNI5.GT.0)
     1CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCONF(XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE (SYMMETRIC) CONFIDENCE LIMITS FOR THE MEAN
C              FOR PROBABILITY VALUE P = .90, .95, .99, .999, AND .9999.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--JULY      1984.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --MARCH     1999. IF 2 VARIABLES SPECIFIED,
C                                       COMPUTE CONFIDENCE INTERVAL
C                                       FOR DIFFERENCE BETWEEN MEANS
C     UPDATED         --MARCH     2003. SAVE CONFIDENCE BOUNDS AS
C                                       INTERNAL PARAMETERS
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      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 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ICASAN
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
CCCCC END CHANGE
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.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='DPCO'
      ISUBN2='NF  '
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
      MAXV2=1
      IF(ICASAN.EQ.'TWOV')MAXV2=2
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
      N2=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE CONFIDENCE LIMITS 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 DPCONF--')
      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 ')
      WRITE(ICOUT,57)ICASAN
   57 FORMAT('ICASAN = ',A4)
      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 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 DPCONF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FROM WHICH CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WERE TO HAVE BEEN CALCULATED)')
      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)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               ****************************************
C               **  STEP 3A--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS MUST BE A VARIABLE          **
C               ****************************************
C
      ISTEPN='3A'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASAN.NE.'TWOV')GOTO440
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
      NUMVAR=2
C
C               ********************************************************
C               **  STEP 3B--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='3B'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.GE.MINN2)GOTO419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('***** ERROR IN DPCONF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)
  402 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,403)
  403 FORMAT('      A DIFFERENCE OF MEANS CONFIDENCE INTERVAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)
  404 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,405)MINN2
  405 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,406)
  406 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,407)IH21,IH22
  407 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,408)N2
  408 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,409)
  409 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,411)(IANS(I),I=1,MAX(IWIDTH,80))
  411 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  419 CONTINUE
C
C               ********************************************************
C               **  STEP 3C--                                         **
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='3B'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(N2.NE.NLEFT)GOTO439
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,421)
CC421 FORMAT('***** ERROR IN DPPRCL--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,422)
CC422 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,423)
CC423 FORMAT('      A DIFFERENCE OF PROPORTIONS CONFIDENCE INTERVAL')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,424)
CC424 FORMAT('      WAS TO HAVE BEEN CARRIED OUT MUST HAVE THE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,425)MINN2
CC425 FORMAT('      SAME NUMNER OF OBSERVATIONS FOR BOTH VARIABLES.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,426)
CC426 FORMAT('      SUCH WAS NOT THE CASE HERE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,427)IHLEFT,IHLEF2,NLEFT
CC427 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,427)IH21,IH22,N2
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,429)
CC429 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IF(IWIDTH.GE.1)WRITE(ICOUT,430)(IANS(I),I=1,MAX(IWIDTH,80))
CC430 FORMAT(80A1)
CCCCC IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
  439 CONTINUE
C
  440 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 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,MAX(NLEFT,N2)
      ISUB(I)=1
  515 CONTINUE
      NQ=MAX(NLEFT,N2)
      GOTO550
C
  520 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCONF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      ARE TO BE CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      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
  570 CONTINUE
      NS=J
C
      IF(NUMVAR.GE.2)THEN
C
        J=0
        IMAX=N2
        IF(NQ.LT.N2)IMAX=NQ
        DO580I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO580
        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
  580   CONTINUE
        NS2=J
      ENDIF
C
C               ******************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPCOF2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE CONFIDENCE LIMITS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPCONF, AS WE ARE ABOUT TO CALL DPCOF2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
C  SEPTEMBER, 1987: CHANGE NAME TO AVOID CONFLICT WITH A COMMON DECK
C
CCCCC CALL DPCOF2(Y,W,NS,XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
      CALL DPCNF2(Y,W,NS,X,NS2,XTEMP1,XTEMP2,MAXNXT,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ICAPSW,ICAPTY,
     1ICASAN,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 DPCONF--')
      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 DPCONH(IVAL,VAL,IH,NH,IBUGD2,IERROR)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPCON2.
C           IT HAS BEEN DUPLICATED AND PLACED
C           ON THIS BRANCH OF THE OVERLAY/SEGMENTATION
C           TREE STRUCTURE IN ORDER TO ACHIEVE
C           FASTER EXECUTION TIME.
C
C     NOTE--UPON INPUT, IVALUE IS USUALLY INT(VALUE+0.5), BUT
C       FOR NEGATIVE VALUE, IVALUE SHOULD BE INT(VALUE-0.5)
C
C     PURPOSE--CONVERT NUMERIC VALUE INTO CORRESPONDING
C              CHARACTER STRING.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MARCH   1983.
C     UPDATED         --JANUARY  2000. SUPPORT FOR EXPONENTIAL
C                                      EXPANSION (THIS IS PRIMARILY
C                                      FOR USE WITH THE FIT COMMAND)
C     UPDATED         --FEBRUARY 2005. SUPPORT FOR "SET PARAMETER
C                                      EXPAND DIGITS"
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHREM
      CHARACTER*4 IHNUM
      CHARACTER*4 IHTEMI
      CHARACTER*4 IHTEMD
C
      CHARACTER*25 IJUNK
      CHARACTER*10 IFORMT
C
      DIMENSION IH(*)
      DIMENSION IHTEMI(10)
      DIMENSION IHTEMD(10)
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      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-----DATA STATEMENTS-------------------------------------------------
C
C-----START POINT---------------------------------------------------------
C
      AINUM=0.0
      FRACT=0.0
      NUMDID=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CONH')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCONH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IVAL,VAL
   52 FORMAT('IVAL,VAL = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(IEXPPA.EQ.'EXPO')THEN
        IJUNK=' '
        WRITE(IJUNK,'(D20.12)')DBLE(VAL)
        NH=1
        IH(1)='('
        DO1010I=1,20
          IF(IJUNK(I:I).EQ.'D')THEN
            DO1020J=1,MAX(1,I-1)
              IF(IJUNK(J:J).EQ.' ')GOTO1020
              NH=NH+1
              IH(NH)=IJUNK(J:J)
 1020       CONTINUE
            IPOS=I+1
            GOTO1019
          ENDIF
 1010   CONTINUE
 1019   CONTINUE
C
        NH=NH+1
        IH(NH)='*'
        NH=NH+1
        IH(NH)='1'
        NH=NH+1
        IH(NH)='0'
        NH=NH+1
        IH(NH)='*'
        NH=NH+1
        IH(NH)='*'
        NH=NH+1
        IH(NH)='('
        DO1040I=IPOS,20
          IF(IJUNK(I:I).EQ.' ')GOTO1040
          NH=NH+1
          IH(NH)=IJUNK(I:I)
 1040   CONTINUE
C
        NH=NH+1
        IH(NH)=')'
        NH=NH+1
        IH(NH)=')'
        GOTO9000
      ELSEIF(IEXPDI.GT.0)THEN
C
        IJUNK=' '
        IFORMT=' '
        IFORMT(1:8)='(F  .  )'
        NJUNK=IEXPDI
        IF(NJUNK.GT.9)NJUNK=9
        WRITE(IFORMT(6:7),'(I2)')NJUNK
        NJUNK=NJUNK+8
        WRITE(IFORMT(3:4),'(I2)')NJUNK
        WRITE(IJUNK,IFORMT)VAL
C
        NH=0
        DO1050I=1,NJUNK
          IF(NH.EQ.0 .AND. IJUNK(I:I).EQ.' ')GOTO1050
          NH=NH+1
          IH(NH)=IJUNK(I:I)
 1050   CONTINUE
        GOTO9000
      ELSEIF(IEXPDI.EQ.0)THEN
C
        IJUNK=' '
        IFORMT=' '
        IFORMT(1:5)='(I15)'
        WRITE(IJUNK,IFORMT)INT(VAL+0.5)
C
        NH=0
        DO1060I=1,15
          IF(NH.EQ.0 .AND. IJUNK(I:I).EQ.' ')GOTO1060
          NH=NH+1
          IH(NH)=IJUNK(I:I)
 1060   CONTINUE
        GOTO9000
      ENDIF
C
      ABSVAL=ABS(VAL)
C
      AIVAL=IVAL
      DEL=AIVAL-VAL
      ABSDEL=ABS(DEL)
C
      ABSRAT=ABSDEL
      IF(ABSVAL.GE.1.0)ABSRAT=ABSDEL/ABSVAL
C
CCCCC CUTDEL=10.0**(-16)
      CUTDEL=10.0**(-6)
      CUTRAT=10.0**(-6)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CONH')GOTO919
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,911)
  911 FORMAT('***** FROM THE MIDDLE OF DPCONH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,912)ABSVAL
  912 FORMAT('ABSVAL = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)VAL,IVAL,AIVAL,DEL,ABSDEL
  913 FORMAT('VAL,IVAL,AIVAL,DEL,ABSDEL = ',E15.7,I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,914)ABSDEL,CUTDEL
  914 FORMAT('ABSDEL,CUTDEL = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,915)ABSRAT,CUTRAT
  915 FORMAT('ABSRAT,CUTRAT = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
  919 CONTINUE
C
      IF(ABSVAL.LT.1.0.AND.ABSDEL.LE.CUTDEL)GOTO1000
      IF(ABSVAL.GE.1.0.AND.ABSRAT.LE.CUTRAT)GOTO1000
      GOTO2000
C
C               ******************************
C               **  STEP XX--               **
C               **  TREAT THE INTEGER CASE  **
C               ******************************
C
 1000 CONTINUE
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')WRITE(ICOUT,1005)
 1005 FORMAT('*****INTEGER CASE*****')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')CALL DPWRST('XXX','BUG ')
C
      INUM=IABS(IVAL)
      NUMDII=0
      IF(INUM.EQ.0)NUMDII=NUMDII+1
      IF(INUM.EQ.0)IHTEMI(NUMDII)='0'
      IF(INUM.EQ.0)GOTO1190
C
      DO1100I=1,10
      IF(INUM.LE.0)GOTO1190
      IRATIO=INUM/10
      IREM=INUM-10*IRATIO
      INUM=IRATIO
      NUMDII=NUMDII+1
      CALL DPCODH(IREM,IHREM,IBUGD2,IERROR)
      IHTEMI(NUMDII)=IHREM
 1100 CONTINUE
 1190 CONTINUE
      IF(IVAL.LT.0)NUMDII=NUMDII+1
      IF(IVAL.LT.0)IHTEMI(NUMDII)='-'
C
      NH=NUMDII
      IF(NUMDII.LE.0)GOTO1290
      DO1200I=1,NUMDII
      IREV=NUMDII-I+1
      IH(I)=IHTEMI(IREV)
 1200 CONTINUE
 1290 CONTINUE
C
      GOTO9000
C
C               **********************************
C               **  STEP XX--                   **
C               **  TREAT THE NON-INTEGER CASE  **
C               **********************************
C
 2000 CONTINUE
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')WRITE(ICOUT,2005)
 2005 FORMAT('*****NON-INTEGER CASE*****')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')CALL DPWRST('XXX','BUG ')
C
      INUM=ABSVAL
      AINUM=INUM
      FRACT=ABSVAL-AINUM
C
      NUMDII=0
      IF(INUM.EQ.0)NUMDII=NUMDII+1
      IF(INUM.EQ.0)IHTEMI(NUMDII)='0'
      IF(INUM.EQ.0)GOTO2190
C
      DO2100I=1,10
      IF(INUM.LE.0)GOTO2190
      IRATIO=INUM/10
      IREM=INUM-10*IRATIO
      INUM=IRATIO
      NUMDII=NUMDII+1
      CALL DPCODH(IREM,IHREM,IBUGD2,IERROR)
      IHTEMI(NUMDII)=IHREM
 2100 CONTINUE
 2190 CONTINUE
      IF(VAL.LT.0)NUMDII=NUMDII+1
      IF(VAL.LT.0)IHTEMI(NUMDII)='-'
C
      NUMDID=0
      IF(FRACT.EQ.0.0)NUMDID=0
      IF(FRACT.EQ.0.0)GOTO2390
C
      ANUM=FRACT
      NLOOP=8-NUMDII
CCCCC CUTOF2=10.0**(-NLOOP+1)
CCCCC CUTOF3=1.0-CUTOF2
      IF(NLOOP.LE.0)GOTO2390
      DO2300I=1,NLOOP
      CUTOF2=10.0**(-NLOOP+I+1)
      CUTOF3=1.0-CUTOF2
      ANUM=ANUM*10.0
      INUM=INT(ANUM)
      AINUM=REAL(INUM)
      DEL3=ANUM-AINUM
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')WRITE(ICOUT,2311)
     1NLOOP,I,CUTOF3,CUTOF2
 2311 FORMAT('NLOOP,I,CUTOF3,CUTOF2 = ',I8,I8,2E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')WRITE(ICOUT,2312)
     1ANUM,AINUM,DEL3,CUTOF3
 2312 FORMAT('ANUM,AINUM,DEL3,CUTOF3 = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')CALL DPWRST('XXX','BUG ')
      IF(CUTOF3.GT.0.0000001)THEN
        IF(DEL3.GE.CUTOF3)INUM=INUM+1
        IF(DEL3.GE.CUTOF3)ANUM=INUM
      ELSE
        IF(DEL3.GE.0.5)INUM=INUM+1
        IF(DEL3.GE.0.5)ANUM=INUM
      ENDIF
      NUMDID=NUMDID+1
      CALL DPCODH(INUM,IHNUM,IBUGD2,IERROR)
      IHTEMD(NUMDID)=IHNUM
      AINUM=INUM
      DEL2=ANUM-AINUM
      ANUM=DEL2
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')WRITE(ICOUT,2313)
     1ANUM,AINUM,DEL2,CUTOF2
 2313 FORMAT('ANUM,AINUM,DEL2,CUTOF2 = ',4E15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CONH')CALL DPWRST('XXX','BUG ')
      IF(DEL2.LE.CUTOF2)GOTO2390
 2300 CONTINUE
 2390 CONTINUE
C
      NH=0
      IF(NUMDII.LE.0)GOTO2490
      DO2400I=1,NUMDII
      NH=NH+1
      IREV=NUMDII-I+1
      IH(NH)=IHTEMI(IREV)
 2400 CONTINUE
 2490 CONTINUE
C
      NH=NH+1
      IH(NH)='.'
C
      IF(NUMDID.LE.0)GOTO2590
      DO2500I=1,NUMDID
      NH=NH+1
      IH(NH)=IHTEMD(I)
 2500 CONTINUE
 2590 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CONH')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCONH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IVAL,VAL
 9012 FORMAT('IVAL,VAL = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)AIVAL,VAL,DEL,ABSDEL,CUTDEL
 9013 FORMAT('AIVAL,VAL,DEL,ABSDEL,CUTDEL = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ABSVAL,INUM,AINUM,FRACT
 9014 FORMAT('ABSVAL,INUM,AINUM,FRACT = ',E15.7,2X,I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMDII
 9015 FORMAT('NUMDII = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(IHTEMI(I),I=1,NUMDII)
 9016 FORMAT('(IHTEMI(I),I=1,NUMDII) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)NUMDID
 9025 FORMAT('NUMDID = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)(IHTEMD(I),I=1,NUMDID)
 9026 FORMAT('(IHTEMD(I),I=1,NUMDID) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NH
 9031 FORMAT('NH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)(IH(I),I=1,NH)
 9032 FORMAT('(IH(I),I=1,NH) = ',20A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCONX(IX,IC)
C
C     PURPOSE--CONVERT IX = INTEGER IN INTERVAL 0 - 255 TO
C              HEX EQUIVALENT (CHARACTER*2).
C              USE BUILT TABLE FOR PEFORMANCE.
C
C
C     WRITTEN BY--JAMES J. FILLIBEN
C     LANGUAGE--ANSI FORTRAN (1977)
C     ORIGINAL VERSION--MARCH     2002.
C
C--------------------------------------------------------------------
C
      CHARACTER*2 IC
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
      CHARACTER*2 HEXTAB(256)
C
C-----DATA STATEMENTS-------------------------------------------------
C
C     DATA STATEMENTS FOR IBM EBCDIC COMPUTERS
C
      DATA HEXTAB(  1) /'00'/
      DATA HEXTAB(  2) /'01'/
      DATA HEXTAB(  3) /'02'/
      DATA HEXTAB(  4) /'03'/
      DATA HEXTAB(  5) /'04'/
      DATA HEXTAB(  6) /'05'/
      DATA HEXTAB(  7) /'06'/
      DATA HEXTAB(  8) /'07'/
      DATA HEXTAB(  9) /'08'/
      DATA HEXTAB( 10) /'09'/
      DATA HEXTAB( 11) /'0A'/
      DATA HEXTAB( 12) /'0B'/
      DATA HEXTAB( 13) /'0C'/
      DATA HEXTAB( 14) /'0D'/
      DATA HEXTAB( 15) /'0E'/
      DATA HEXTAB( 16) /'0F'/
      DATA HEXTAB( 17) /'10'/
      DATA HEXTAB( 18) /'11'/
      DATA HEXTAB( 19) /'12'/
      DATA HEXTAB( 20) /'13'/
      DATA HEXTAB( 21) /'14'/
      DATA HEXTAB( 22) /'15'/
      DATA HEXTAB( 23) /'16'/
      DATA HEXTAB( 24) /'17'/
      DATA HEXTAB( 25) /'18'/
      DATA HEXTAB( 26) /'19'/
      DATA HEXTAB( 27) /'1A'/
      DATA HEXTAB( 28) /'1B'/
      DATA HEXTAB( 29) /'1C'/
      DATA HEXTAB( 30) /'1D'/
      DATA HEXTAB( 31) /'1E'/
      DATA HEXTAB( 32) /'1F'/
      DATA HEXTAB( 33) /'20'/
      DATA HEXTAB( 34) /'21'/
      DATA HEXTAB( 35) /'22'/
      DATA HEXTAB( 36) /'23'/
      DATA HEXTAB( 37) /'24'/
      DATA HEXTAB( 38) /'25'/
      DATA HEXTAB( 39) /'26'/
      DATA HEXTAB( 40) /'27'/
      DATA HEXTAB( 41) /'28'/
      DATA HEXTAB( 42) /'29'/
      DATA HEXTAB( 43) /'2A'/
      DATA HEXTAB( 44) /'2B'/
      DATA HEXTAB( 45) /'2C'/
      DATA HEXTAB( 46) /'2D'/
      DATA HEXTAB( 47) /'2E'/
      DATA HEXTAB( 48) /'2F'/
      DATA HEXTAB( 49) /'30'/
      DATA HEXTAB( 50) /'31'/
      DATA HEXTAB( 51) /'32'/
      DATA HEXTAB( 52) /'33'/
      DATA HEXTAB( 53) /'34'/
      DATA HEXTAB( 54) /'35'/
      DATA HEXTAB( 55) /'36'/
      DATA HEXTAB( 56) /'37'/
      DATA HEXTAB( 57) /'38'/
      DATA HEXTAB( 58) /'39'/
      DATA HEXTAB( 59) /'3A'/
      DATA HEXTAB( 60) /'3B'/
      DATA HEXTAB( 61) /'3C'/
      DATA HEXTAB( 62) /'3D'/
      DATA HEXTAB( 63) /'3E'/
      DATA HEXTAB( 64) /'3F'/
      DATA HEXTAB( 65) /'40'/
      DATA HEXTAB( 66) /'41'/
      DATA HEXTAB( 67) /'42'/
      DATA HEXTAB( 68) /'43'/
      DATA HEXTAB( 69) /'44'/
      DATA HEXTAB( 70) /'45'/
      DATA HEXTAB( 71) /'46'/
      DATA HEXTAB( 72) /'47'/
      DATA HEXTAB( 73) /'48'/
      DATA HEXTAB( 74) /'49'/
      DATA HEXTAB( 75) /'4A'/
      DATA HEXTAB( 76) /'4B'/
      DATA HEXTAB( 77) /'4C'/
      DATA HEXTAB( 78) /'4D'/
      DATA HEXTAB( 79) /'4E'/
      DATA HEXTAB( 80) /'4F'/
      DATA HEXTAB( 81) /'50'/
      DATA HEXTAB( 82) /'51'/
      DATA HEXTAB( 83) /'52'/
      DATA HEXTAB( 84) /'53'/
      DATA HEXTAB( 85) /'54'/
      DATA HEXTAB( 86) /'55'/
      DATA HEXTAB( 87) /'56'/
      DATA HEXTAB( 88) /'57'/
      DATA HEXTAB( 89) /'58'/
      DATA HEXTAB( 90) /'59'/
      DATA HEXTAB( 91) /'5A'/
      DATA HEXTAB( 92) /'5B'/
      DATA HEXTAB( 93) /'5C'/
      DATA HEXTAB( 94) /'5D'/
      DATA HEXTAB( 95) /'5E'/
      DATA HEXTAB( 96) /'5F'/
      DATA HEXTAB( 97) /'60'/
      DATA HEXTAB( 98) /'61'/
      DATA HEXTAB( 99) /'62'/
      DATA HEXTAB(100) /'63'/
      DATA HEXTAB(101) /'64'/
      DATA HEXTAB(102) /'65'/
      DATA HEXTAB(103) /'66'/
      DATA HEXTAB(104) /'67'/
      DATA HEXTAB(105) /'68'/
      DATA HEXTAB(106) /'69'/
      DATA HEXTAB(107) /'6A'/
      DATA HEXTAB(108) /'6B'/
      DATA HEXTAB(109) /'6C'/
      DATA HEXTAB(110) /'6D'/
      DATA HEXTAB(111) /'6E'/
      DATA HEXTAB(112) /'6F'/
      DATA HEXTAB(113) /'70'/
      DATA HEXTAB(114) /'71'/
      DATA HEXTAB(115) /'72'/
      DATA HEXTAB(116) /'73'/
      DATA HEXTAB(117) /'74'/
      DATA HEXTAB(118) /'75'/
      DATA HEXTAB(119) /'76'/
      DATA HEXTAB(120) /'77'/
      DATA HEXTAB(121) /'78'/
      DATA HEXTAB(122) /'79'/
      DATA HEXTAB(123) /'7A'/
      DATA HEXTAB(124) /'7B'/
      DATA HEXTAB(125) /'7C'/
      DATA HEXTAB(126) /'7D'/
      DATA HEXTAB(127) /'7E'/
      DATA HEXTAB(128) /'7F'/
      DATA HEXTAB(129) /'80'/
      DATA HEXTAB(130) /'81'/
      DATA HEXTAB(131) /'82'/
      DATA HEXTAB(132) /'83'/
      DATA HEXTAB(133) /'84'/
      DATA HEXTAB(134) /'85'/
      DATA HEXTAB(135) /'86'/
      DATA HEXTAB(136) /'87'/
      DATA HEXTAB(137) /'88'/
      DATA HEXTAB(138) /'89'/
      DATA HEXTAB(139) /'8A'/
      DATA HEXTAB(140) /'8B'/
      DATA HEXTAB(141) /'8C'/
      DATA HEXTAB(142) /'8D'/
      DATA HEXTAB(143) /'8E'/
      DATA HEXTAB(144) /'8F'/
      DATA HEXTAB(145) /'90'/
      DATA HEXTAB(146) /'91'/
      DATA HEXTAB(147) /'92'/
      DATA HEXTAB(148) /'93'/
      DATA HEXTAB(149) /'94'/
      DATA HEXTAB(150) /'95'/
      DATA HEXTAB(151) /'96'/
      DATA HEXTAB(152) /'97'/
      DATA HEXTAB(153) /'98'/
      DATA HEXTAB(154) /'99'/
      DATA HEXTAB(155) /'9A'/
      DATA HEXTAB(156) /'9B'/
      DATA HEXTAB(157) /'9C'/
      DATA HEXTAB(158) /'9D'/
      DATA HEXTAB(159) /'9E'/
      DATA HEXTAB(160) /'9F'/
      DATA HEXTAB(161) /'A0'/
      DATA HEXTAB(162) /'A1'/
      DATA HEXTAB(163) /'A2'/
      DATA HEXTAB(164) /'A3'/
      DATA HEXTAB(165) /'A4'/
      DATA HEXTAB(166) /'A5'/
      DATA HEXTAB(167) /'A6'/
      DATA HEXTAB(168) /'A7'/
      DATA HEXTAB(169) /'A8'/
      DATA HEXTAB(170) /'A9'/
      DATA HEXTAB(171) /'AA'/
      DATA HEXTAB(172) /'AB'/
      DATA HEXTAB(173) /'AC'/
      DATA HEXTAB(174) /'AD'/
      DATA HEXTAB(175) /'AE'/
      DATA HEXTAB(176) /'AF'/
      DATA HEXTAB(177) /'B0'/
      DATA HEXTAB(178) /'B1'/
      DATA HEXTAB(179) /'B2'/
      DATA HEXTAB(180) /'B3'/
      DATA HEXTAB(181) /'B4'/
      DATA HEXTAB(182) /'B5'/
      DATA HEXTAB(183) /'B6'/
      DATA HEXTAB(184) /'B7'/
      DATA HEXTAB(185) /'B8'/
      DATA HEXTAB(186) /'B9'/
      DATA HEXTAB(187) /'BA'/
      DATA HEXTAB(188) /'BB'/
      DATA HEXTAB(189) /'BC'/
      DATA HEXTAB(190) /'BD'/
      DATA HEXTAB(191) /'BE'/
      DATA HEXTAB(192) /'BF'/
      DATA HEXTAB(193) /'C0'/
      DATA HEXTAB(194) /'C1'/
      DATA HEXTAB(195) /'C2'/
      DATA HEXTAB(196) /'C3'/
      DATA HEXTAB(197) /'C4'/
      DATA HEXTAB(198) /'C5'/
      DATA HEXTAB(199) /'C6'/
      DATA HEXTAB(200) /'C7'/
      DATA HEXTAB(201) /'C8'/
      DATA HEXTAB(202) /'C9'/
      DATA HEXTAB(203) /'CA'/
      DATA HEXTAB(204) /'CB'/
      DATA HEXTAB(205) /'CC'/
      DATA HEXTAB(206) /'CD'/
      DATA HEXTAB(207) /'CE'/
      DATA HEXTAB(208) /'CF'/
      DATA HEXTAB(209) /'D0'/
      DATA HEXTAB(210) /'D1'/
      DATA HEXTAB(211) /'D2'/
      DATA HEXTAB(212) /'D3'/
      DATA HEXTAB(213) /'D4'/
      DATA HEXTAB(214) /'D5'/
      DATA HEXTAB(215) /'D6'/
      DATA HEXTAB(216) /'D7'/
      DATA HEXTAB(217) /'D8'/
      DATA HEXTAB(218) /'D9'/
      DATA HEXTAB(219) /'DA'/
      DATA HEXTAB(220) /'DB'/
      DATA HEXTAB(221) /'DC'/
      DATA HEXTAB(222) /'DD'/
      DATA HEXTAB(223) /'DE'/
      DATA HEXTAB(224) /'DF'/
      DATA HEXTAB(225) /'E0'/
      DATA HEXTAB(226) /'E1'/
      DATA HEXTAB(227) /'E2'/
      DATA HEXTAB(228) /'E3'/
      DATA HEXTAB(229) /'E4'/
      DATA HEXTAB(230) /'E5'/
      DATA HEXTAB(231) /'E6'/
      DATA HEXTAB(232) /'E7'/
      DATA HEXTAB(233) /'E8'/
      DATA HEXTAB(234) /'E9'/
      DATA HEXTAB(235) /'EA'/
      DATA HEXTAB(236) /'EB'/
      DATA HEXTAB(237) /'EC'/
      DATA HEXTAB(238) /'ED'/
      DATA HEXTAB(239) /'EE'/
      DATA HEXTAB(240) /'EF'/
      DATA HEXTAB(241) /'F0'/
      DATA HEXTAB(242) /'F1'/
      DATA HEXTAB(243) /'F2'/
      DATA HEXTAB(244) /'F3'/
      DATA HEXTAB(245) /'F4'/
      DATA HEXTAB(246) /'F5'/
      DATA HEXTAB(247) /'F6'/
      DATA HEXTAB(248) /'F7'/
      DATA HEXTAB(249) /'F8'/
      DATA HEXTAB(250) /'F9'/
      DATA HEXTAB(251) /'FA'/
      DATA HEXTAB(252) /'FB'/
      DATA HEXTAB(253) /'FC'/
      DATA HEXTAB(254) /'FD'/
      DATA HEXTAB(255) /'FE'/
      DATA HEXTAB(256) /'FF'/
C
C-----START POINT-----------------------------------------------------
C
      IF(IX.LE.0)THEN
        IC=HEXTAB(1)
      ELSEIF(IX.GE.255)THEN
        IC=HEXTAB(256)
      ELSE
        IC=HEXTAB(IX+1)
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCOPY(IHARG,IARGT,IARG,NUMARG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN IMMEDIATE COPY OF THE SCREEN
C              ONTO THE LOCAL HARDCOPY UNIT
C              FOR DISPLAY TERMINALS
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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  1980.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C
C-----NON-COMMON VARIABLES----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
C
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
C
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      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
      ISUBN1='DPCO'
      ISUBN2='SC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IBUGG4=IBUGD2
      ISUBG4=ISUBRO
      IERRG4=IERROR
C
      NUMCOP=1
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 DPCOPY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGD2,IBUGG4
   53 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IFOUND,IERROR
   54 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMCOP
   55 FORMAT('NUMCOP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I),IARG(I)
   62 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      WRITE(ICOUT,70)NUMDEV
   70 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO71I=1,NUMDEV
      WRITE(ICOUT,72)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   72 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
   73 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
   74 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
      WRITE(ICOUT,82)IMANUF,IMODEL,IMODE2,IMODE3
   82 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IGCONT,IGCOLO
   83 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)NUMVPP,NUMHPP,ANUMVP,ANUMHP
   84 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  EXTRACT NEEDED INFORMATION FROM THE COMMAND LINE  **
C               ********************************************************
C
      IF(NUMARG.GE.1.AND.IARGT(NUMARG).EQ.'NUMB')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      NUMCOP=1
      GOTO1150
C
 1120 CONTINUE
      NUMCOP=IARG(NUMARG)
      GOTO1150
C
 1150 CONTINUE
      IFOUND='YES'
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
      IGUNIT=IDUNIT(IDEVIC)
C
C               ******************************************************
C               **  STEP 2.1--                                      **
C               **  TREAT THE COPY  CASE FOR PRINTERS  **
C               **  AND DISCRETE TERMINALS                          **
C               **  (NO COPY IS DONE)              ZZ
C               ******************************************************
C
      ISTEPN='2.1'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IGCONT.EQ.'ON')GOTO1900
      GOTO8000
 1900 CONTINUE
C
C               ****************************************
C               **  STEP 2.2--                        **
C               **  TREAT THE COPY CASE               **
C               **  FOR CONTINUOUS TERMINALS.         **
C               ****************************************
C
      ISTEPN='2.2'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMCOP.LE.0)GOTO1290
      DO1200I=1,NUMCOP
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1205)
 1205 FORMAT('***** A COPY SHOULD BE MADE NOW *****')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      CALL GRCOSC
 1200 CONTINUE
 1290 CONTINUE
C
 8000 CONTINUE
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 DPCOPY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD2,IBUGG4
 9013 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFOUND,IERROR
 9014 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMCOP
 9015 FORMAT('NUMCOP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I),IARG(I)
 9022 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
      WRITE(ICOUT,9030)NUMDEV
 9030 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9031I=1,NUMDEV
      WRITE(ICOUT,9032)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
 9032 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
 9033 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
 9034 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9031 CONTINUE
      WRITE(ICOUT,9042)IMANUF,IMODEL,IMODE2,IMODE3
 9042 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IGCONT,IGCOLO
 9043 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)NUMVPP,NUMHPP,ANUMVP,ANUMHP
 9044 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOR2(Y1,Y2,N,ICASPL,NUMLAG,MAXN,IAUTCP,IAUTL0,
     1Y,X,D,TOP,BOTTOM,PCC,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) AN AUTOCORRELATION PLOT
C                   2) A CROSS-CORRELATION PLOT
C                   3) A PARTIAL AUTOCORRELATION PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MAY       1992. REWRITE AUTOCORR. FOR SMALL N
C     UPDATED         --FEBRUARY  1993. PARTIAL AUTOCORRELATION PLOT
C     UPDATED         --DECEMBER  1994. FIX XLIMITS /REF. LINES PROBLEM
C     UPDATED         --JULY      1999. SUPPORT FIXED OR MOVING ERROR
C                                       LIMITS.
C     UPDATED         --FEBRUARY  2003. SUPPORT OPTION TO OMIT LAG 0 ON
C                                       AUTOCORRELATION AND PARTIAL
C                                       AUTOCORRELATION PLOT (IAUTL0)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC ADD FOLLOWING LINE JULY 1999
      CHARACTER*4 IAUTCP
CCCCC ADD FOLLOWING LINE FEBRUARY 2003
      CHARACTER*4 IAUTL0
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
CCCCC MAY 1995.  ADD FOLLOWING LINE
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IFOUND
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
CCCCC TO DO--THE FOLLOWING DIMENSIONS MUST BE GENERALIZED BEYOND 1000
CCCCC 2/93
CCCCC MOVE FOLLOWING DIMENSIONS TO DPCORR.   OCTOBER 1997
CCCCC DIMENSION TOP(1000)
CCCCC DIMENSION BOTTOM(1000)
CCCCC DIMENSION PCC(1000)
      DIMENSION TOP(*)
      DIMENSION BOTTOM(*)
      DIMENSION PCC(*)
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='DPCO'
      ISUBN2='R2  '
C
      IERROR='NO'
C
      J=(-999)
      KMAX=(-999)
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPCOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=Y1(1)
      DO60I=1,N
      IF(Y1(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPCOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COR2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPCOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMLAG,MAXN
   71 FORMAT('N,ICASPL,NUMLAG,MAXN = ',I8,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y1(I),Y2(I)
   74 FORMAT('I, Y1(I), Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
C               *******************************
C               **  STEP 2--                 **
C               **  IF NECESSARY,            **
C               **  COMPUTE THE MAXIMUM LAG  **
C               *******************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXLAG=MAXN
      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
CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1992 (JJF)
      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--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      IF(ICASPL.EQ.'AUCO')GOTO1000
      IF(ICASPL.EQ.'CRCO')GOTO2000
      IF(ICASPL.EQ.'PACO')GOTO3000
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPCOR2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      AUCO, CRCO, OR PACO , BUT IS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ******************************************************
C               **  STEP 4.1--                                      **
C               **  COMPUTE THE AUTOCORRELATIONS FOR THE X  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
 1000 CONTINUE
      ISTEPN='4.1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.16)GOTO1100
      GOTO1200
C
C     COMPUTE AUTOCORRELATIONS FOR N <= 20
C
 1100 CONTINUE
      AN=N
C
      DO1110K=1,KMAXM1
      NMK=N-K
      ANMK=NMK
      SUM1=0.0
      SUM2=0.0
      DO1120I=1,NMK
      J=I+K
      SUM1=SUM1+Y1(I)
      SUM2=SUM2+Y1(J)
 1120 CONTINUE
      Y1BAR=SUM1/ANMK
      Y2BAR=SUM2/ANMK
C
      SUM1=0.0
      SUM2=0.0
      DO1130I=1,NMK
      J=I+K
      SUM1=SUM1+(Y1(I)-Y1BAR)**2
      SUM2=SUM2+(Y1(J)-Y2BAR)**2
 1130 CONTINUE
      SSQ1=SUM1
      SSQ2=SUM2
C
      SUM1=0.0
      DO1140I=1,NMK
      J=I+K
      SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(J)-Y2BAR)
 1140 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
      D(K)=AC
 1110 CONTINUE
      GOTO1300
C
C     COMPUTE AUTOCORRELATIONS FOR N >= 21
C
 1200 CONTINUE
      AN=N
C
      SUM1=0.0
      DO1210I=1,N
      SUM1=SUM1+Y1(I)
 1210 CONTINUE
      Y1BAR=SUM1/AN
C
      SUM1=0.0
      DO1220I=1,N
      SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(I)-Y1BAR)
 1220 CONTINUE
      VARB1=SUM1/AN
      VAR1=SUM1/(AN-1.0)
C
      DO1230K=1,KMAXM1
      SUM1=0.0
      NMK=N-K
      DO1240I=1,NMK
      J=I+K
      SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(J)-Y1BAR)
 1240 CONTINUE
      D(K)=SUM1/AN
      D(K)=D(K)/VARB1
 1230 CONTINUE
      GOTO1300
C
C     FORM OUTPUT VECTORS FOR BOTH AUTOCORRELATION CASES
C
 1300 CONTINUE
      YMID=0.0
      SDR=1.0/SQRT(AN)
      YUPP95=1.96*SDR
      YLOW95=(-YUPP95)
      YUPP99=2.576*SDR
      YLOW99=(-YUPP99)
      IOUT=0
C
      J=0
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=1.0
        X(J)=0.0
      ENDIF
      DO1310K=1,KMAXM1
      J=J+1
      Y(J)=D(K)
      X(J)=K
      IF(Y(J).GT.YUPP95)IOUT=IOUT+1
      IF(Y(J).LT.YLOW95)IOUT=IOUT+1
 1310 CONTINUE
      AIOUT=IOUT
      AKMAXM=KMAXM1
      PEROUT=100.0*(AIOUT/AKMAXM)
C
      J=0
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        D(J)=1.0
      ENDIF
      DO1320K=1,KMAXM1
      J=J+1
      D(J)=1.0
 1320 CONTINUE
C
CCCCC THE FOLLOWING 6 SECTIONS WERE REWRITTEN          DECEMBER 1994
CCCCC TO FIX PROBLEM OF NON-APPEARING REFERENCE LINES  DECEMBER 1994
CCCCC WHEN HAVE TIGHT XLIMITS                          DECEMBER 1994
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(1)
CCCCC D(J)=2.0
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(KMAX)
CCCCC D(J)=2.0
CCCCC ETC.
C
      DO342K=1,KMAXM1
         J=J+1
         Y(J)=YMID
         X(J)=K
         D(J)=2.0
  342 CONTINUE
C
CCCCC SUPPORT FIXED CONFIDENCE BANDS FOR TESTING FOR WHITE NOISE.
CCCCC MOVING BANDS FOR BOX-JENKINS MODELING.
      IF(IAUTCP.NE.'BOXJ')THEN
      DO343K=1,KMAXM1
         J=J+1
         Y(J)=YUPP95
         X(J)=K
         D(J)=3.0
  343 CONTINUE
C
      DO344K=1,KMAXM1
         J=J+1
         Y(J)=YLOW95
         X(J)=K
         D(J)=4.0
  344 CONTINUE
C
      DO345K=1,KMAXM1
         J=J+1
         Y(J)=YUPP99
         X(J)=K
         D(J)=5.0
  345 CONTINUE
C
      DO346K=1,KMAXM1
         J=J+1
         Y(J)=YLOW99
         X(J)=K
         D(J)=6.0
  346 CONTINUE
      ELSE
C
      AFACT=1.0/AN
C
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=YMID
        X(J)=0.0
        D(J)=3.0
      ENDIF
      J=J+1
      Y(J)=YUPP95
      X(J)=1
      D(J)=3.0
      YSUM=0.0
      DO353K=2,KMAXM1
         YSUM=YSUM + Y(K)**2
         J=J+1
         Y(J)=1.96*SQRT(AFACT*(1.0+2.0*YSUM))
         X(J)=K
         D(J)=3.0
  353 CONTINUE
C
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=YMID
        X(J)=0.0
        D(J)=4.0
      ENDIF
      J=J+1
      Y(J)=YLOW95
      X(J)=1.0
      D(J)=4.0
      YSUM=0.0
      DO354K=1,KMAXM1
         YSUM=YSUM + Y(K)**2
         J=J+1
         Y(J)=YLOW95
         Y(J)=-1.96*SQRT(AFACT*(1.0+2.0*YSUM))
         X(J)=K
         D(J)=4.0
  354 CONTINUE
C
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=YMID
        X(J)=0.0
        D(J)=5.0
      ENDIF
      J=J+1
      Y(J)=YUPP99
      X(J)=1
      D(J)=5.0
      YSUM=0.0
      DO355K=1,KMAXM1
         YSUM=YSUM + Y(K)**2
         J=J+1
         Y(J)=2.576*SQRT(AFACT*(1.0+2.0*YSUM))
         X(J)=K
         D(J)=5.0
  355 CONTINUE
C
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=YMID
        X(J)=0.0
        D(J)=6.0
      ENDIF
      J=J+1
      Y(J)=YLOW99
      X(J)=1
      D(J)=6.0
      YSUM=0.0
      DO356K=1,KMAXM1
         YSUM=YSUM + Y(K)**2
         J=J+1
         Y(J)=-2.576*SQRT(AFACT*(1.0+2.0*YSUM))
         X(J)=K
         D(J)=6.0
  356 CONTINUE
      ENDIF
C
      NPLOTP=J
      NPLOTV=3
C
      CALL DPWCCP(ICASPL,
     1YLOW95,YUPP95,IOUT,KMAXM1,PEROUT,
     1IBUGG3,ISUBRO,IFOUND,IERROR)
C
      GOTO9000
C
C               **********************************************************
C               **  STEP 4.2--                                          **
C               **  COMPUTE CROSS-CORRELATIONS FOR THE X AND 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
 2000 CONTINUE
      ISTEPN='4.2'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AN=N
C
      SUM1=0.0
      SUM2=0.0
      DO2110I=1,N
      SUM1=SUM1+Y1(I)
      SUM2=SUM2+Y2(I)
 2110 CONTINUE
      Y1BAR=SUM1/AN
      Y2BAR=SUM2/AN
C
      SUM1=0.0
      SUM2=0.0
      DO2120I=1,N
      SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(I)-Y1BAR)
      SUM2=SUM2+(Y2(I)-Y2BAR)*(Y2(I)-Y2BAR)
 2120 CONTINUE
      VARB1=SUM1/AN
      VARB2=SUM2/AN
      VAR1=SUM1/(AN-1.0)
      VAR2=SUM2/(AN-1.0)
      DENOM=0.0
      PROD=VAR1*VAR2
      IF(PROD.GT.0.0)DENOM=SQRT(PROD)
C
      INDEX=0
C
      DO2130K=1,KMAXM1
      INDEX=INDEX+1
      KREV=KMAXM1-K+1
      SUM12=0.0
      NMKREV=N-KREV
      DO2132I=1,NMKREV
      J=I+KREV
      SUM12=SUM12+(Y1(J)-Y1BAR)*(Y2(I)-Y2BAR)
 2132 CONTINUE
      D(INDEX)=SUM12/AN
 2130 CONTINUE
C
      K=0
      INDEX=INDEX+1
      SUM12=0.0
      DO2134I=1,N
      J=I
      SUM12=SUM12+(Y1(I)-Y1BAR)*(Y2(J)-Y2BAR)
 2134 CONTINUE
      D(INDEX)=SUM12/AN
C
      DO2136K=1,KMAXM1
      INDEX=INDEX+1
      SUM12=0.0
      NMK=N-K
      DO2138I=1,NMK
      J=I+K
      SUM12=SUM12+(Y1(I)-Y1BAR)*(Y2(J)-Y2BAR)
 2138 CONTINUE
      D(INDEX)=SUM12/AN
 2136 CONTINUE
C
CCCCC NPLOTP=INDEX
CCCCC NPLOTV=2
C
      YMID=0.0
      SDR=1.0/SQRT(AN)
      YUPP95=1.96*SDR
      YLOW95=(-YUPP95)
      YUPP99=2.576*SDR
      YLOW99=(-YUPP99)
C
      L=(-KMAXM1-1)
      DO2150J2=1,INDEX
      J=J2
      L=L+1
      Y(J)=1.0
      IF(DENOM.GT.0.0)Y(J)=D(J)/DENOM
      X(J)=L
      D(J)=1.0
 2150 CONTINUE
C
CCCCC THE FOLLOWING 6 SECTIONS WERE REWRITTEN          DECEMBER 1994
CCCCC TO FIX PROBLEM OF NON-APPEARING REFERENCE LINES  DECEMBER 1994
CCCCC WHEN HAVE TIGHT XLIMITS                          DECEMBER 1994
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(1)
CCCCC D(J)=2.0
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(INDEX)
CCCCC D(J)=2.0
CCCCC ETC.
C
      DO2152K=1,INDEX
         J=J+1
         Y(J)=YMID
         X(J)=X(K)
         D(J)=2.0
 2152 CONTINUE
C
      DO2153K=1,INDEX
         J=J+1
         Y(J)=YUPP95
         X(J)=X(K)
         D(J)=3.0
 2153 CONTINUE
C
      DO2154K=1,INDEX
         J=J+1
         Y(J)=YLOW95
         X(J)=X(K)
         D(J)=4.0
 2154 CONTINUE
C
      DO2155K=1,INDEX
         J=J+1
         Y(J)=YUPP99
         X(J)=X(K)
         D(J)=5.0
 2155 CONTINUE
C
      DO2156K=1,INDEX
         J=J+1
         Y(J)=YLOW99
         X(J)=X(K)
         D(J)=6.0
 2156 CONTINUE
C
      NPLOTP=J
      NPLOTV=3
C
      GOTO9000
C
CCCCC THE FOLLOWING ENTIRE SECTION WAS ADDED FEBRUARY 1993
C               ******************************************************
C               **  STEP 4.3--                                      **
C               **  COMPUTE THE PARTIAL AUTOCORRELATIONS FOR THE X  DATA    **
C               **  DO SO IN 4 STEPS--                              **
C               **     1) COMPUTE THE SAMPLE MEAN;                  **
C               **     2) COMPUTE THE SAMPLE VARIANCE;              **
C               **     3) COMPUTE THE AUTOCORRELATIONS;             **
C               **     4) COMPUTE THE PARTIAL AUTOCORRELATIONS;     **
C               **  REFERENCE--JENKINS AND WATTS, PAGE 382 (9.3.1)  **
C               **  REFERENCE--WEISS, COMMUNICATIONS IN STATISTICS  **, PAGE 382 (9.3.1)  **
C               ******************************************************
C
 3000 CONTINUE
      ISTEPN='4.3'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'COR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
C     IF N <= 16, COMPUTE (SIMPLE) AUTOCORRELATIONS
C
      IF(N.LE.16)THEN
         AN=N
C
         DO3110K=1,KMAXM1
            NMK=N-K
            ANMK=NMK
            SUM1=0.0
            SUM2=0.0
            DO3120I=1,NMK
               J=I+K
               SUM1=SUM1+Y1(I)
               SUM2=SUM2+Y1(J)
 3120       CONTINUE
            Y1BAR=SUM1/ANMK
            Y2BAR=SUM2/ANMK
C
            SUM1=0.0
            SUM2=0.0
            DO3130I=1,NMK
               J=I+K
               SUM1=SUM1+(Y1(I)-Y1BAR)**2
               SUM2=SUM2+(Y1(J)-Y2BAR)**2
 3130       CONTINUE
            SSQ1=SUM1
            SSQ2=SUM2
C
            SUM1=0.0
            DO3140I=1,NMK
               J=I+K
               SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(J)-Y2BAR)
 3140       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
            D(K)=AC
 3110    CONTINUE
      ENDIF
C
C     IF N >= 17, COMPUTE (SIMPLE) AUTOCORRELATIONS
C
      IF(N.GE.17)THEN
         AN=N
C
         SUM1=0.0
         DO3210I=1,N
            SUM1=SUM1+Y1(I)
 3210    CONTINUE
         Y1BAR=SUM1/AN
C
         SUM1=0.0
         DO3220I=1,N
            SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(I)-Y1BAR)
 3220    CONTINUE
         VARB1=SUM1/AN
         VAR1=SUM1/(AN-1.0)
C
         DO3230K=1,KMAXM1
            SUM1=0.0
            NMK=N-K
            DO3240I=1,NMK
               J=I+K
               SUM1=SUM1+(Y1(I)-Y1BAR)*(Y1(J)-Y1BAR)
 3240       CONTINUE
            D(K)=SUM1/AN
            D(K)=D(K)/VARB1
 3230    CONTINUE
      ENDIF
C
C     FORM PARTIAL AUTOCORRELATIONS FROM SIMPLE AUTOCORRELATIONS
C     REFERENCE--WEISS, COMMUN. OF STAT., 1984, P. 541-542.
C
      K=KMAXM1
      I=0
      I2=I+1
      TOP(I2)=1.0
      BOTTOM(I2)=1.0
      DO3310I=1,K
         I2=I+1
         TOP(I2)=D(I)
         BOTTOM(I2)=D(I)
 3310 CONTINUE
C
      PCC(1)=1.0
      DO3320J=1,K
         J2=J+1
         PCC(J2)=TOP(1+1)/BOTTOM(0+1)
         IF(IBUGG3.EQ.'ON')THEN
            WRITE(6,3321)J,J2,PCC(J2)
 3321       FORMAT('J,J2,PCC(J2) = ',I8,I8,F10.5)
         ENDIF
         KMJ=K-J
         DO3330I=1,KMJ
            I2=I+1
            BOTTOM(I2-1)=BOTTOM(I2-1)-TOP(I2)*PCC(J2)
            TOP(I2)=TOP(I2+1)-BOTTOM(I2)*PCC(J2)
 3330    CONTINUE
 3320 CONTINUE
C
C     FORM OUTPUT VECTORS
C
      YMID=0.0
      SDR=1.0/SQRT(AN)
      YUPP95=1.96*SDR
      YLOW95=(-YUPP95)
      YUPP99=2.576*SDR
      YLOW99=(-YUPP99)
      IOUT=0
C
      J=0
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        Y(J)=PCC(1)
        X(J)=0.0
      ENDIF
      DO3410K=1,KMAXM1
         J=J+1
         Y(J)=PCC(K+1)
         X(J)=K
         IF(Y(J).GT.YUPP95)IOUT=IOUT+1
         IF(Y(J).LT.YLOW95)IOUT=IOUT+1
 3410 CONTINUE
      AIOUT=IOUT
      AKMAXM=KMAXM1
      PEROUT=100.0*(AIOUT/AKMAXM)
C
      J=0
      IF(IAUTL0.EQ.'ON')THEN
        J=J+1
        D(J)=1.0
      ENDIF
      DO3420K=1,KMAXM1
      J=J+1
      D(J)=1.0
 3420 CONTINUE
C
CCCCC THE FOLLOWING 6 SECTIONS WERE REWRITTEN          DECEMBER 1994
CCCCC TO FIX PROBLEM OF NON-APPEARING REFERENCE LINES  DECEMBER 1994
CCCCC WHEN HAVE TIGHT XLIMITS                          DECEMBER 1994
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(1)
CCCCC D(J)=2.0
CCCCC J=J+1
CCCCC Y(J)=YMID
CCCCC X(J)=X(KMAX)
CCCCC D(J)=2.0
CCCCC ETC.
C
      DO3442K=1,KMAXM1
         J=J+1
         Y(J)=YMID
         X(J)=X(K)
         D(J)=2.0
 3442 CONTINUE
C
      DO3443K=1,KMAXM1
         J=J+1
         Y(J)=YUPP95
         X(J)=X(K)
         D(J)=3.0
 3443 CONTINUE
C
      DO3444K=1,KMAXM1
         J=J+1
         Y(J)=YLOW95
         X(J)=X(K)
         D(J)=4.0
 3444 CONTINUE
C
      DO3445K=1,KMAXM1
         J=J+1
         Y(J)=YUPP99
         X(J)=X(K)
         D(J)=5.0
 3445 CONTINUE
C
      DO3446K=1,KMAXM1
         J=J+1
         Y(J)=YLOW99
         X(J)=X(K)
         D(J)=6.0
 3446 CONTINUE
C
      NPLOTP=J
      NPLOTV=3
C
      CALL DPWCCP(ICASPL,
     1YLOW95,YUPP95,IOUT,KMAXM1,PEROUT,
     1IBUGG3,ISUBRO,IFOUND,IERROR)
C
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'COR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCOR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NUMLAG,N,KMAX,NPLOTP,IERROR
 9012 FORMAT('ICASPL,NUMLAG,N,KMAX,NPLOTP,IERROR = ',A4,4I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,10
      WRITE(ICOUT,9021)I,D(I),TOP(I),BOTTOM(I),PCC(I)
 9021 FORMAT('I,D(I),TOP(I),BOTTOM(I),PCC(I) = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCORR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM
C              1) AUTOCORRELATION PLOT
C              2) CROSS-CORRELATION PLOT
C              3) PARTIAL AUTOCORRELATION PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --FEBRUARY  1990.  PARTIAL AUTOECORRELATION PLOT
C     UPDATED         --OCTOBER   1997.  MOVE SOME DIMENSIONS TO DPCORR
C     UPDATED         --JULY      1999.  ADD IAUTCP PARAMETER
C     UPDATED         --FEBRUARY  2003.  ADD IAUTL0 PARAMETER
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHVA21
      CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED OCTOBER, 1997
      DIMENSION TOP(MAXOBV)
      DIMENSION BOTTOM(MAXOBV)
      DIMENSION PCC(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
CCCCC FOLLOWING LINES ADDED OCTOBER, 1997
      EQUIVALENCE (GARBAG(IGARB3),TOP(1))
      EQUIVALENCE (GARBAG(IGARB4),BOTTOM(1))
      EQUIVALENCE (GARBAG(IGARB5),PCC(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC ADD FOLLOWING LINE JULY 1999
      INCLUDE 'DPCOST.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
      ISUBN1='DPCO'
      ISUBN2='RR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
C               ****************************************************************
C               **  TREAT THE FOLLOWING CASES--                                *
C               **        1) AUTOCORRELATION                                   *
C               **        2) CROSS-CORRELATION;                                *
C               **        3) PARTIAL AUTO-CORRELATION;                      *
C               ****************************************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CORR')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN FEBRUARY 1993
C               ***************************************
C               **  STEP 1.1--                       **
C               **  SEARCH FOR AUTOCORRELATION PLOT  **
C               ***************************************
C
      ICASPL='AUCO'
C
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'CORR'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN FEBRUARY 1993
C               *****************************************
C               **  STEP 1.2--                         **
C               **  SEARCH FOR CROSS-CORRELATION PLOT  **
C               *****************************************
C
      ICASPL='CRCO'
C
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'CORR'.AND.
     1   IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SCOR'.AND.
     1   IHARG(1).EQ.'PLOT')GOTO111
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1993
C               ************************************************
C               **  STEP 1.3--                                **
C               **  SEARCH FOR PARTIAL AUTO-CORRELATION PLOT  **
C               ************************************************
C
      ICASPL='PACO'
C
      IF(NUMARG.GE.3)THEN
         IF(ICOM.EQ.'PART'.AND.IHARG(1).EQ.'AUTO'.AND.
     1   IHARG(2).EQ.'CORR'.AND.IHARG(3).EQ.'PLOT')GOTO113
      ENDIF
      IF(NUMARG.GE.2)THEN
         IF(ICOM.EQ.'PART'.AND.IHARG(1).EQ.'AUTO'.AND.
     1   IHARG2(1).EQ.'CORR'.AND.IHARG(2).EQ.'PLOT')GOTO112
      ENDIF
C
      ICASPL='    '
      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
CCCCC THE FOLLOWING 4 LINES WERE ADDED FEBRUARY 1993
  113 CONTINUE
      ILASTC=3
      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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASPL.EQ.'AUCO')GOTO270
      IF(ICASPL.EQ.'CRCO')GOTO280
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
      IF(ICASPL.EQ.'PACO')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPCORR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,264)
  264 FORMAT('      AUCO, CRCO, OR PACO,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,IWIDTH)
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  280 CONTINUE
      MAXV2=2
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL 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 POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH AN AUTO OR CROSS-CORRELATION ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IS TO BE 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)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 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(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='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
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CORR')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                             **
C               **  (EXACTLY 1                               **
C               **  FOR AN AUTOCORRELATION PLOT              **
C               **  AND A PARTIAL AUTOCORRELATION PLOT       **
C               **  EXACTLY 2                                **
C               **  FOR A CROSS-CORRELATION PLOT.            **
C               **  ALSO, FOR A CROSS-CORRELATION PLOT,      **
C               **  CHECK THE VALIDITY                       **
C               **  OF THE SECOND VARIABLE.                  **
C               **  DOES THE NAME EXIST IN THE TABLE?        **
C               **  DOES THE NUMBER OF ELEMENTS              **
C               **  IN THE SECOND VARIABLE                   **
C               **  AGREE WITH THE NUMBER OF ELEMENTS        **
C               **  IN THE FIRST VARIABLE?                   **
C               ***********************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO509
      GOTO550
C
  509 CONTINUE
      IF(NUMV2.LE.1)GOTO590
      IHVA21=IHARG(2)
      IHVA22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVA21,IHVA22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV2=IVALUE(ILOCV)
      NVAR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHVA21,IHVA22,ICOLV2,NVAR2
  511 FORMAT('IHVA21,IHVA22,ICOLV2,NVAR2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NVAR2.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CROSS-CORRELATION PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)NUMV2
  557 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A CROSS-CORRELATION PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)IHLEFT,IHLEF2,NLEFT
  577 FORMAT('      THE FIRST  VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)IHVA21,IHVA22,NVAR2
  578 FORMAT('      THE SECOND VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,580)(IANS(I),I=1,IWIDTH)
  580 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE FIRST  VARIABLE; **
C               **  ALSO, FOR A CROSS-CORRELATION PLOT,     **
C               **  FORM THE VARIABLE Y2(.)                 **
C               **  WHICH WILL CONTAIN THE SECOND VARIABLE. **
C               **  FORM THESE VARIABLES BY                 **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO610
      IF(ICASQ.EQ.'SUBS')GOTO620
      IF(ICASQ.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
      IF(NQ.GE.MINN2)GOTO660
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)
  651 FORMAT('***** ERROR IN DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)
  652 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)IHLEFT,IHLEF2
  653 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      (FOR WHICH AN AUTO, CROSS, OR PARTIAL AUTO-')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      CORRELATION PLOT    IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      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)
      IF(MAXV2.LE.1)GOTO670
C
      IJ=MAXN*(ICOLV2-1)+I
      IF(ICOLV2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLV2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLV2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLV2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLV2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLV2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLV2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C               **********************************************************
C               **  STEP 8--                                            **
C               **  DETERMINE IF THE ANALYST                            **
C               **  HAS SPECIFIED THE NUMBER OF LAGS DESIRED            **
C               **  FOR THE CROSS-CORRELATION PLOT.                     **
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='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     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')GOTO790
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')GOTO790
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')GOTO790
C
  790 CONTINUE
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'CORR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPCOR2(Y1,Y2,NS,ICASPL,NUMLAG,MAXN,IAUTCP,IAUTL0,
     1Y,X,D,TOP,BOTTOM,PCC,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CORR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCORR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMLAG,MAXN
 9014 FORMAT('NUMLAG,MAXN = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCOVA(K,NLEFT,XOUT)
C
C     PURPOSE--COPY THE NLEFT ELEMENTS OF VARIABLE K INTO XOUT().
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
C
      DIMENSION XOUT(*)
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
      J=0
      DO1000I=1,NLEFT
      IF(ISUB(I).EQ.0)GOTO1000
      J=J+1
      IJ=MAXN*(K-1)+I
      IF(K.LE.MAXCOL)XOUT(J)=V(IJ)
      IF(K.EQ.(MAXCOL+1))XOUT(J)=PRED(I)
      IF(K.EQ.(MAXCOL+2))XOUT(J)=RES(I)
      IF(K.EQ.(MAXCOL+3))XOUT(J)=YPLOT(I)
      IF(K.EQ.(MAXCOL+4))XOUT(J)=XPLOT(I)
      IF(K.EQ.(MAXCOL+5))XOUT(J)=X2PLOT(I)
      IF(K.EQ.(MAXCOL+6))XOUT(J)=TAGPLO(I)
 1000 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCR(IHARG,NUMARG,
     1IDEFCR,
     1ITEXCR,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CARRIAGE RETURN SWITCH (ON OR OFF) FOR
C              TEXT SCRIPT.
C              THE CARRIAGE RETURN SWITCH WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXCR.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFCR
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXCR
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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 IDEFCR
      CHARACTER*4 ITEXCR
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      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(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFCR
   53 FORMAT('IDEFCR = ',A4)
      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)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  TREAT THE CARRIAGE RETURN CASE  **
C               **************************************
C
      IF(NUMARG.LE.0)GOTO1161
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'RETU')GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO1170
C
 1161 CONTINUE
      ITEXCR='ON'
      GOTO1180
C
 1162 CONTINUE
      ITEXCR='OFF'
      GOTO1180
C
 1165 CONTINUE
      ITEXCR=IDEFCR
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPCR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      ILLEGAL ENTRY FOR CARRIAGE RETURN ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      TO HAVE A CARRIAGE RETURN AFTER THE TEXT ',
     1'COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1177)
 1177 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1178)
 1178 FORMAT('           CARRIAGE RETURN ON     (OR   CR ON) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1179)
 1179 FORMAT('           CARRIAGE RETURN        (OR   CR) ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE CARRIAGE RETURN (AFTER TEXT) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXCR
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      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 DPCR')
      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)IDEFCR,ITEXCR
 9013 FORMAT('IDEFCR,ITEXCR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCRLF(IHARG,NUMARG,
     1IDEFCR,IDEFLF,
     1ITEXCR,ITEXLF,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE CARRIAGE RETURN AND LINE FEED SWITCHES
C              (ON OR OFF) FOR
C              TEXT SCRIPT.
C              THE CARRIAGE RETURN AND LINE FEED SWITCHES WILL BE PLACED
C              IN THE CHARACTER VARIABLES ITEXCR AND ITEXLF.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFCR
C                     --IDEFLF
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXCR
C                     --ITEXLF
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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 IDEFCR
      CHARACTER*4 IDEFLF
      CHARACTER*4 ITEXCR
      CHARACTER*4 ITEXLF
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      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(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFCR,IDEFLF
   53 FORMAT('IDEFCR,IDEFLF = ',A4,2X,A4)
      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)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  TREAT THE CARRIAGE RETURN CASE  **
C               **************************************
C
      IF(NUMARG.LE.0)GOTO1161
      IF(IHARG(NUMARG).EQ.'ON')GOTO1161
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1162
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1161
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1165
      GOTO1170
C
 1161 CONTINUE
      ITEXCR='ON'
      ITEXLF='ON'
      GOTO1180
C
 1162 CONTINUE
      ITEXCR='OFF'
      ITEXLF='OFF'
      GOTO1180
C
 1165 CONTINUE
      ITEXCR=IDEFCR
      ITEXLF=IDEFLF
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1171)
 1171 FORMAT('***** ERROR IN DPCR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('      ILLEGAL ENTRY FOR CARRIAGE RETURN ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)
 1175 FORMAT('      TO HAVE A CARRIAGE RETURN/LINE FEED ',
     1'AFTER THE TEXT COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1177)
 1177 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1178)
 1178 FORMAT('           CRLF ON')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1179)
 1179 FORMAT('           CRLF')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE CARRIAGE RETURN/LINE FEED (AFTER TEXT) ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXCR
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      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 DPCR')
      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)IDEFCR,ITEXCR
 9013 FORMAT('IDEFCR,ITEXCR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IDEFLF,ITEXLF
 9014 FORMAT('IDEFLF,ITEXLF = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCROS(ICOM,IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IANS,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--READ THE COORDINATES OF THE CROSS-HAIR.
C              SUCH COORDINATES WILL BE IN
C              STANDARDIZED (0.0 TO 100.0) UNITS.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --FEBRUARY  1998.  SUPPORT FORM OF COMMAND FOR
C                                        GUI
C
C-----NON-COMMON VARIABLES------------------------------------------------------
C
      CHARACTER*4 ICOM
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
C
      CHARACTER*4 IANS
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICOPSJ
C
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
      CHARACTER*4 IOP
      CHARACTER*4 MESSAG
      CHARACTER*4 IFOUNN
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION IANS(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      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
      IBUGG4=IBUGD2
      ISUBG4=ISUBRO
C
      PXRATI=(-999.0)
      PYRATI=(-999.0)
      PXRANG=(-999.0)
      PYRANG=(-999.0)
      FXRANG=(-999.0)
      FYRANG=(-999.0)
      ILOCP3=(-999)
C
      ILOC=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CROS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCROS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('(IANS(I),I=1,IWIDTH) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NUMARG
   61 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,NUMARG
      WRITE(ICOUT,63)I,IHARG(I),IHARG2(I),IARGT(I),ARG(I)
   63 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
      WRITE(ICOUT,71)NUMNAM,MAXNAM
   71 FORMAT('NUMNAM,MAXNAM= ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,NUMNAM
      WRITE(ICOUT,73)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   73 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),',
     1'VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,85)PXMIN,PXMAX,PYMIN,PYMAX
   85 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)FX1MIN,FX1MAX,FY1MIN,FY1MAX
   86 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  EXTRACT NEEDED INFORMATION FROM THE COMMAND LINE  **
C               ********************************************************
C
      IF(ICOM.EQ.'CH'.AND.IHARG(1).EQ.'ON')GOTO1111
      IF(ICOM.EQ.'CH'.AND.IHARG(1).EQ.'AUTO')GOTO1111
      IF(ICOM.EQ.'CH'.AND.IHARG(1).EQ.'DEFA')GOTO1190
      IF(ICOM.EQ.'CH'.AND.IHARG(1).EQ.'OFF')GOTO1190
      IF(ICOM.EQ.'CH'.AND.NUMARG.GE.0)GOTO1110
C
      IF(IHARG(1).EQ.'CH'.AND.IHARG(2).EQ.'ON')GOTO1112
      IF(IHARG(1).EQ.'CH'.AND.IHARG(2).EQ.'AUTO')GOTO1112
      IF(IHARG(1).EQ.'CH'.AND.IHARG(2).EQ.'DEFA')GOTO1190
      IF(IHARG(1).EQ.'CH'.AND.IHARG(2).EQ.'OFF')GOTO1190
      IF(IHARG(1).EQ.'CH'.AND.NUMARG.GE.1)GOTO1111
C
      IF(IHARG(1).EQ.'HAIR'.AND.IHARG(2).EQ.'ON')GOTO1112
      IF(IHARG(1).EQ.'HAIR'.AND.IHARG(2).EQ.'AUTO')GOTO1112
      IF(IHARG(1).EQ.'HAIR'.AND.IHARG(2).EQ.'DEFA')GOTO1190
      IF(IHARG(1).EQ.'HAIR'.AND.IHARG(2).EQ.'OFF')GOTO1190
      IF(IHARG(1).EQ.'HAIR'.AND.NUMARG.GE.1)GOTO1111
C
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1IHARG(3).EQ.'ON')GOTO1113
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1IHARG(3).EQ.'AUTO')GOTO1113
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1IHARG(3).EQ.'OFF')GOTO1190
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1IHARG(3).EQ.'DEFA')GOTO1190
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1NUMARG.GE.2)GOTO1112
C
      GOTO9000
C
 1110 CONTINUE
      ILOC=0
      GOTO1190
C
 1111 CONTINUE
      ILOC=1
      GOTO1190
C
 1112 CONTINUE
      ILOC=2
      GOTO1190
C
 1113 CONTINUE
      ILOC=3
      GOTO1190
C
 1190 CONTINUE
CCCCC FEBRUARY 1998.
CCCCC SUPPORT FORM OF COMMAND:
CCCCC     CROSS-HAIR 22.1  34.6
CCCCC FOR GUI.  THIS FORM WILL PRINT THE COORDINATES IN THE MOST
CCCCC RECENT PLOT UNITS.
      IF(NUMARG.EQ.2..AND.IARGT(1).EQ.'NUMB'.AND.
     1   IARGT(2).EQ.'NUMB')THEN
        PXCOOR=ARG(1)
        PYCOOR=ARG(2)
        PXRANG=PXMAX-PXMIN
        PYRANG=PYMAX-PYMIN
        FXRANG=PXRANG
        IF(FX1MIN.NE.CPUMIN.AND.FX1MIN.NE.CPUMAX.AND.
     1     FX1MAX.NE.CPUMIN.AND.FX1MAX.NE.CPUMAX)
     1     FXRANG=FX1MAX-FX1MIN
        FYRANG=PYRANG
        IF(FY1MIN.NE.CPUMIN.AND.FY1MIN.NE.CPUMAX.AND.
     1    FY1MAX.NE.CPUMIN.AND.FY1MAX.NE.CPUMAX)
     1   FYRANG=FY1MAX-FY1MIN
C
        PXRATI=(-999.0)
        IF(PXRANG.GT.0.0)PXRATI=(PXCOOR-PXMIN)/PXRANG
        XCOOR=PXCOOR
        IF(FX1MIN.NE.CPUMIN.AND.FX1MIN.NE.CPUMAX.AND.
     1     FX1MAX.NE.CPUMIN.AND.FX1MAX.NE.CPUMAX)
     1     XCOOR=FX1MIN+PXRATI*FXRANG
        IF(PYRANG.LE.0.0)PYRATI=(-999.0)
        IF(PYRANG.GT.0.0)PYRATI=(PYCOOR-PYMIN)/PYRANG
        YCOOR=PYCOOR
        IF(FY1MIN.NE.CPUMIN.AND.FY1MIN.NE.CPUMAX.AND.
     1     FY1MAX.NE.CPUMIN.AND.FY1MAX.NE.CPUMAX)
     1     YCOOR=FY1MIN+PYRATI*FYRANG
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2186)XCOOR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2187)YCOOR
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2188)
        CALL DPWRST('XXX','BUG ')
        IFOUND='YES'
        GOTO9000
      ENDIF
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ***********************************
C               **  STEP 3--                     **
C               **  READ THE SCREEN COORDINATES  **
C               ***********************************
C
      CALL GRRESC(PXCOOR,PYCOOR)
C
C               ************************************
C               **  STEP 3.5--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSJ='OFF'
      NUMCOJ=0
      CALL DPCLPL(ICOPSJ,NUMCOJ,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
C               ***************************************
C               **  STEP 4--                         **
C               **  UPDATE INTERNAL DATAPLOT ARRAYS  **
C               ***************************************
C
C
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.NUMARG)GOTO2180
      IHWORD=IHARG(ILOCP1)
      IHWOR2=IHARG2(ILOCP1)
      IOP='CHAD'
      MESSAG='NO'
      CALL UPDATP(IHWORD,IHWOR2,PXCOOR,IOP,MESSAG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGD2,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILOCP2=ILOC+2
      IF(ILOCP2.GT.NUMARG)GOTO2180
      IHWORD=IHARG(ILOCP2)
      IHWOR2=IHARG2(ILOCP2)
      IOP='CHAD'
      MESSAG='NO'
      CALL UPDATP(IHWORD,IHWOR2,PYCOOR,IOP,MESSAG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGD2,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      PXRANG=PXMAX-PXMIN
      PYRANG=PYMAX-PYMIN
C
      FXRANG=PXRANG
      IF(FX1MIN.NE.CPUMIN.AND.FX1MIN.NE.CPUMAX.AND.
     1   FX1MAX.NE.CPUMIN.AND.FX1MAX.NE.CPUMAX)
     1   FXRANG=FX1MAX-FX1MIN
C
      FYRANG=PYRANG
      IF(FY1MIN.NE.CPUMIN.AND.FY1MIN.NE.CPUMAX.AND.
     1   FY1MAX.NE.CPUMIN.AND.FY1MAX.NE.CPUMAX)
     1   FYRANG=FY1MAX-FY1MIN
C
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,2170)PXRANG,PYRANG,FXRANG,FYRANG
 2170 FORMAT('PXRANG,PYRANG,FXRANG,FYRANG = ',4E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      ILOCP3=ILOC+3
      IF(ILOCP3.GT.NUMARG)GOTO2180
      PXRATI=(-999.0)
      IF(PXRANG.GT.0.0)PXRATI=(PXCOOR-PXMIN)/PXRANG
      XCOOR=PXCOOR
      IF(FX1MIN.NE.CPUMIN.AND.FX1MIN.NE.CPUMAX.AND.
     1   FX1MAX.NE.CPUMIN.AND.FX1MAX.NE.CPUMAX)
     1   XCOOR=FX1MIN+PXRATI*FXRANG
      IHWORD=IHARG(ILOCP3)
      IHWOR2=IHARG2(ILOCP3)
      IOP='CHAD'
      MESSAG='NO'
      CALL UPDATP(IHWORD,IHWOR2,XCOOR,IOP,MESSAG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGD2,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILOCP4=ILOC+4
      IF(ILOCP4.GT.NUMARG)GOTO2180
      IF(PYRANG.LE.0.0)PYRATI=(-999.0)
      IF(PYRANG.GT.0.0)PYRATI=(PYCOOR-PYMIN)/PYRANG
      YCOOR=PYCOOR
      IF(FY1MIN.NE.CPUMIN.AND.FY1MIN.NE.CPUMAX.AND.
     1   FY1MAX.NE.CPUMIN.AND.FY1MAX.NE.CPUMAX)
     1   YCOOR=FY1MIN+PYRATI*FYRANG
      IHWORD=IHARG(ILOCP4)
      IHWOR2=IHARG2(ILOCP4)
      IOP='CHAD'
      MESSAG='NO'
      CALL UPDATP(IHWORD,IHWOR2,YCOOR,IOP,MESSAG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGD2,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
 2180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO2189
C
 2181 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2182)PXCOOR
 2182 FORMAT('X COOR. = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2183)PYCOOR
 2183 FORMAT('Y COOR. = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2184)
 2184 FORMAT('(IN 0 TO 100 UNITS)')
      CALL DPWRST('XXX','BUG ')
C
      IF(ILOCP3.GT.NUMARG)GOTO2189
      IF(ICOM.EQ.'CH'.AND.NUMARG.LE.0)GOTO2189
      IF(IHARG(1).EQ.'CH'.AND.NUMARG.LE.1)GOTO2189
      IF(IHARG(1).EQ.'CROS'.AND.IHARG(2).EQ.'HAIR'.AND.
     1NUMARG.LE.2)GOTO2189
C
 2185 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2186)XCOOR
 2186 FORMAT('X COOR. = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2187)YCOOR
 2187 FORMAT('Y COOR. = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2188)
 2188 FORMAT('(IN UNITS OF THE DATA)')
      CALL DPWRST('XXX','BUG ')
      GOTO2189
C
 2189 CONTINUE
      GOTO9000
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IERROR=IERRG4
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CROS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCROS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)PXCOOR,PYCOOR
 9012 FORMAT('PXCOOR,PYCOOR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ILOC
 9013 FORMAT('ILOC = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IWIDTH
 9014 FORMAT('IWIDTH= ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(IANS(I),I=1,IWIDTH)
 9015 FORMAT('(IANS(I),I=1,IWIDTH) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NUMARG
 9021 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NUMARG
      WRITE(ICOUT,9023)I,IHARG(I),IHARG2(I),IARGT(I),ARG(I)
 9023 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      WRITE(ICOUT,9031)NUMNAM,MAXNAM
 9031 FORMAT('NUMNAM,MAXNAM= ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9032I=1,NUMNAM
      WRITE(ICOUT,9033)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9033 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),',
     1'VALUE(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
      WRITE(ICOUT,9035)IMANUF,IMODEL
 9035 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)IFOUND
 9037 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)IBUGG4,ISUBG4,IERRG4
 9038 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGD2,IERROR
 9039 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)PXMIN,PXMAX,PYMIN,PYMAX
 9045 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)FX1MIN,FX1MAX,FY1MIN,FY1MAX
 9046 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)PXRANG,PYRANG,FXRANG,FYRANG
 9047 FORMAT('PXRANG,PYRANG,FXRANG,FYRANG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCRPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING CROSS TABULATE PLOTS--
C
C                 FOLLOWING REQUIRE ONE RESPONSE VARIABLE
C                 MEAN CROSS TABULATE PLOT
C                 MIDM CROSS TABULATE PLOT
C                 MEDI CROSS TABULATE PLOT
C                 SD CROSS TABULATE PLOT
C                 REL SD CROSS TABULATE PLOT
C                 SD MEAN CROSS TABULATE PLOT
C                 VARI CROSS TABULATE PLOT
C                 REL VARI CROSS TABULATE PLOT
C                 VARI MEAN CROSS TABULATE PLOT
C                 RANG CROSS TABULATE PLOT
C                 MINI CROSS TABULATE PLOT
C                 MAXI CROSS TABULATE PLOT
C                 EXTREME CROSS TABULATE PLOT
C                 SKEW CROSS TABULATE PLOT
C                 KURT CROSS TABULATE PLOT
C                 AUCR CROSS TABULATE PLOT
C                 SDM CROSS TABULATE PLOT
C                 AUCV CROSS TABULATE PLOT
C                 LOWH CROSS TABULATE PLOT
C                 UPPH CROSS TABULATE PLOT
C                 LOWQ CROSS TABULATE PLOT
C                 UPPQ CROSS TABULATE PLOT
C                 TRIM CROSS TABULATE PLOT
C                 WINM CROSS TABULATE PLOT
C                 MIDQ CROSS TABULATE PLOT
C                 1DEC CROSS TABULATE PLOT
C                 2DEC CROSS TABULATE PLOT
C                 3DEC CROSS TABULATE PLOT
C                 4DEC CROSS TABULATE PLOT
C                 5DEC CROSS TABULATE PLOT
C                 6DEC CROSS TABULATE PLOT
C                 7DEC CROSS TABULATE PLOT
C                 8DEC CROSS TABULATE PLOT
C                 9DEC CROSS TABULATE PLOT
C                 SINE FREQUENCY CROSS TABULATE PLOT
C                 SINE AMPLITUDE CROSS TABULATE PLOT
C                 TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 CP CROSS TABULATE PLOT
C                 CPL CROSS TABULATE PLOT
C                 CPU CROSS TABULATE PLOT
C                 CPK CROSS TABULATE PLOT
C                 CPM CROSS TABULATE PLOT
C                 CC CROSS TABULATE PLOT
C                 CNPK CROSS TABULATE PLOT
C                 PERCENT DEFECTIVE CROSS TABULATE PLOT
C                 EXPECTED LOSS CROSS TABULATE PLOT
C                 NORM PPCC CROSS TABULATE CROSS TABULATE PLOT
C                 AAD CROSS TABULATE PLOT
C                 MAD CROSS TABULATE PLOT
C                 SN CROSS TABULATE PLOT
C                 QN CROSS TABULATE PLOT
C                 PERCENTILE CROSS TABULATE PLOT
C                 GEOMETRIC MEAN CROSS TABULATE PLOT
C                 GEOMETRIC STANDARD DEVIATION CROSS TABULATE PLOT
C                 HARMONIC MEAN CROSS TABULATE PLOT
C                 INTERQUARTILE RANGE CROSS TABULATE PLOT
C                 BIWEIGHT LOCATION CROSS TABULATE PLOT
C                 BIWEIGHT SCALE CROSS TABULATE PLOT
C                 WINSORIZED VARIANCE CROSS TABULATE PLOT
C                 WINSORIZED SD CROSS TABULATE PLOT
C                 BIWEIGHT MIDVARIANCE CROSS TABULATE PLOT
C                 PERCENTAGE BEND MIDVARIANCE CROSS TABULATE PLOT
C                 HODGES LEHMAN CROSS TABULATE PLOT
C                 QUANTILE CROSS TABULATE PLOT
C                 QUANTILE STANDARD ERROR CROSS TABULATE PLOT
C                 TRIMMED MEAN STANDARD ERROR CROSS TABULATE PLOT
C                 TRIMMED MEAN STANDARD ERROR CROSS TABULATE PLOT
C
C                 FOLLOWING REQUIRE TWO RESPONSE VARIABLES
C                 CORRELATION CROSS TABULATE PLOT
C                 COVARIANCE CROSS TABULATE PLOT
C                 RANK CORRELATION CROSS TABULATE PLOT
C                 RANK COVARIANCE CROSS TABULATE PLOT
C                 COMOVEMENT CROSS TABULATE PLOT
C                 RANK COMOVEMENT CROSS TABULATE PLOT
C                 KENDELLS TAU CROSS TABULATE PLOT
C                 WINSORIZED COVARIANCE CROSS TABULATE PLOT
C                 WINSORIZED CORRELATION CROSS TABULATE PLOT
C                 BIWEIGHT MIDCOVARIANCE CROSS TABULATE PLOT
C                 BIWEIGHT MIDCORRELATION CROSS TABULATE PLOT
C                 PERCENTAGE BEND CORRELATION CROSS TABULATE PLOT
C                 LINEAR INTERCEPT CROSS TABULATE PLOT
C                 LINEAR SLOPE CROSS TABULATE PLOT
C                 LINEAR RESSD CROSS TABULATE PLOT
C                 LINEAR CORRELATION CROSS TABULATE PLOT
C                 WEIGHTED MEAN CROSS TABULATE PLOT
C                 WEIGHTED SD CROSS TABULATE PLOT
C                 WEIGHTED VARIANCE CROSS TABULATE PLOT
C                 WEIGHTED TRIMMED MEAN CROSS TABULATE PLOT
C                 RATIO CROSS TABULATE PLOT
C
C                 FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C                 STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C                 LOCATION AND SCALE STATISTICS):
C   
C                 LOCATION:
C                 DIFFERENCE OF MEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF MIDMEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF MEDIANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF TRIMMED MEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF WINSORIZED MEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF GEOMETRIC MEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF HARMONIC MEANS CROSS TABULATE PLOT 
C                 DIFFERENCE OF HODGES-LEHMAN CROSS TABULATE PLOT 
C                 DIFFERENCE OF BIWEIGHT LOCATION CROSS TABULATE PLOT 
C   
C                 SCALE:
C                 DIFFERENCE OF STANDARD DEVIATIONS CROSS TABULATE PLOT 
C                 DIFFERENCE OF VARIANCES CROSS TABULATE PLOT 
C                 DIFFERENCE OF AAD CROSS TABULATE PLOT 
C                 DIFFERENCE OF MAD CROSS TABULATE PLOT 
C                 DIFFERENCE OF INTERQUARTILE RANGE CROSS TABULATE PLOT 
C                 DIFFERENCE OF WINSORIZED SD CROSS TABULATE PLOT 
C                 DIFFERENCE OF WINSORIZED VARIANCE CROSS TABULATE PLOT 
C                 DIFFERENCE OF BIWEIGHT MIDVARIANCE CROSS TABULATE PLOT 
C                 DIFFERENCE OF BIWEIGHT SCALE CROSS TABULATE PLOT 
C                 DIFFERENCE OF PERCENTAGE BEND CROSS TABULATE PLOT 
C                 DIFFERENCE OF GEOMETRIC SD CROSS TABULATE PLOT 
C                 DIFFERENCE OF RANGE CROSS TABULATE PLOT 
C                 DIFFERENCE OF MIDRANGE CROSS TABULATE PLOT 
C                 DIFFERENCE OF QUANTILE CROSS TABULATE PLOT 
C                 DIFFERENCE OF SKEWNESS CROSS TABULATE PLOT 
C                 DIFFERENCE OF KURTOSIS CROSS TABULATE PLOT 
C                 DIFFERENCE OF RELATIVE SD CROSS TABULATE PLOT 
C                 DIFFERENCE OF SD OF MEAN CROSS TABULATE PLOT 
C                 DIFFERENCE OF RELATIVE VARIANCE CROSS TABULATE PLOT 
C                 DIFFERENCE OF VARIANCE OF THE MEAN CROSS TABULATE PLOT 
C                 DIFFERENCE OF MINIMUM CROSS TABULATE PLOT 
C                 DIFFERENCE OF MAXIMUM CROSS TABULATE PLOT 
C                 DIFFERENCE OF EXTREMES CROSS TABULATE PLOT 
C                 DIFFERENCE OF COEFFICENT OF VARI CROSS TABULATE PLOT 
C                 DIFFERENCE OF COUNTS CROSS TABULATE PLOT 
C                 DIFFERENCE OF SUM CROSS TABULATE PLOT 
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 BUREAU OF STANDARDS.
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/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C     UPDATED         --APRIL     2001.  ARGUMENT LIST FOR CP, CPK, CPM
C                                        ADD CPL AND CPU PLOTS
C     UPDATED         --OCTOBER   2001.  HARMONIC MEAN, IQ RANGE
C     UPDATED         --NOVEMBER  2001.  BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001.  BIWEIGHT SCALE
C     UPDATED         --JULY      2002.  WINSORIZED VARIANCE
C     UPDATED         --JULY      2002.  WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCORRELATION PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C                                           PLOT
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR PLOT
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD ERROR
C                                       PLOT
C     UPDATED         --MARCH     2003. ADD 35 "DIFFERENCE OF" STATISTICS
C     UPDATED         --MARCH     2003. ADD WEIGHTED MEAN, WEIGHTED SD,
C                                       WEIGHTED VARIANCE
C     UPDATED         --APRIL     2003. ADD SN AND QN (AND DIFFERENCE
C                                       OF).  REQUIRED ADDITION OF
C                                       ADDITIONAL SCRATCH VARIABLES.
C     UPDATED         --MAY       2003. WEIGHTED TRIMMED MEAN
C     UPDATED         --OCTOBER   2004. KENDELLS TAU
C     UPDATED         --SEPTEMBER 2005. RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHHR2
      CHARACTER*4 IHHR22
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
C
      CHARACTER*4 IXVAR
      CHARACTER*4 IYVAR
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
C
      DIMENSION X1(MAXOBV)
      DIMENSION X2(MAXOBV)
      DIMENSION Y1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION XTEMP4(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),X2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y1(1))
      EQUIVALENCE (GARBAG(IGARB4),Z1(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP3(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.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
      IERROR='NO'
C
      ISUBN1='CRPL'
      ISUBN2='    '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLL=0
      ICOLH=0
      ICOLH2=0
      ICOLX=0
C
      IXVAR='OFF'
      IYVAR='ON'
C
C               ******************************************
C               **  TREAT THE CROSS TABULATE PLOT CASE  **
C               ******************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CRPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
   52 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 1--                       **
C               **  EXTRACT THE COMMAND            **
C               **  COMMAND SYNTAX IS:             **
C               **  CROSS TABULATE  PLOT     **
C               *************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(ICOM.NE.'CROS')GOTO9000
      IF(IHARG(1).NE.'TABU')GOTO9000
C
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
      IF(IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO200
      IF(IHARG(1).EQ.'NUMB'.AND.IHARG2(1).EQ.'ER  ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'T   ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'TS  ')GOTO201
      IF(IHARG(1).EQ.'SIZE'.AND.IHARG2(1).EQ.'    ')GOTO201
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SAMP'.AND.IHARG(2).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SUBS'.AND.IHARG(2).EQ.'SIZE')GOTO202
C
      IF(IHARG(1).EQ.'SUM '.AND.IHARG2(1).EQ.'    ')GOTO211
      IF(IHARG(1).EQ.'PROD'.AND.IHARG2(1).EQ.'UCT ')GOTO212
      IF(IHARG(1).EQ.'INTE'.AND.IHARG2(1).EQ.'GRAL')GOTO213
C
      IF(IHARG(1).EQ.'MIDR'.AND.IHARG2(1).EQ.'ANGE')GOTO221
      IF(IHARG(1).EQ.'MEAN'.AND.IHARG2(1).EQ.'    ')GOTO222
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO413
      IF(IHARG(1).EQ.'AAD '.AND.IHARG2(1).EQ.'    ')GOTO414
C
      IF(IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE ')GOTO222
      IF(IHARG(1).EQ.'MIDM'.AND.IHARG2(1).EQ.'EAN ')GOTO223
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO415
      IF(IHARG(1).EQ.'MAD '.AND.IHARG2(1).EQ.'    ')GOTO416
C
      IF(IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1(IHARG(3).NE.'STAN'.AND.IHARG(4).NE.'ERRO'))GOTO225
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WIND'.AND.IHARG(2).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'MEAN')GOTO226
C
      IF(IHARG(1).EQ.'R   '.AND.IHARG2(1).EQ.'    ')GOTO241
      IF(IHARG(1).EQ.'RANG'.AND.IHARG2(1).EQ.'E   ')GOTO241
      IF(IHARG(1).EQ.'MINI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MIN '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MAXI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(IHARG(1).EQ.'MAX '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'ANCE')GOTO254
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VAR '.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.5.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'THE '.AND.
     1IHARG(5).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI')GOTO264
      IF(IHARG(1).EQ.'SD  '.AND.IHARG2(1).EQ.'    ')GOTO265
      IF(IHARG(1).EQ.'S   '.AND.IHARG2(1).EQ.'    ')GOTO265
C
      IF(IHARG(1).EQ.'RS  '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RSD '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'D   ')GOTO271
      IF(IHARG(1).EQ.'RV  '.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RVAR'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'AR  ')GOTO272
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'VARI')GOTO273
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'VARI')GOTO274
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'FIRS'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SECO'.AND.IHARG(2).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'THIR'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'HING')GOTO304
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'THIR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'3RD '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(IHARG(1).EQ.'SKEW'.AND.IHARG2(1).EQ.'NESS')GOTO312
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'FOUR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'4TH '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(IHARG(1).EQ.'KURT'.AND.IHARG2(1).EQ.'OSIS')GOTO314
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'COVA'.AND.
     1IHARG(2).EQ.'PLOT')GOTO321
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'CORR'.AND.
     1IHARG(2).EQ.'PLOT')GOTO322
C
      IF(IHARG(1).EQ.'COVA'.AND.IHARG2(1).EQ.'RIAN')GOTO331
      IF(IHARG(1).EQ.'CORR'.AND.IHARG2(1).EQ.'ELAT')GOTO332
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COVA')GOTO333
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'CORR')GOTO334
      IF(IHARG(1).EQ.'COMO'.AND.IHARG2(1).EQ.'VEME')GOTO335
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COMO')GOTO336
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'KEND'.AND.IHARG(2).EQ.'TAU ')GOTO337
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'DECI')GOTO111
      GOTO119
  111 CONTINUE
      IF(IHARG(1).EQ.'FIRS')GOTO341
      IF(IHARG(1).EQ.'SECO')GOTO342
      IF(IHARG(1).EQ.'THIR')GOTO343
      IF(IHARG(1).EQ.'FOUR')GOTO344
      IF(IHARG(1).EQ.'FIFT')GOTO345
      IF(IHARG(1).EQ.'SIXT')GOTO346
      IF(IHARG(1).EQ.'SEVE')GOTO347
      IF(IHARG(1).EQ.'EIGH')GOTO348
      IF(IHARG(1).EQ.'NINT')GOTO349
  119 CONTINUE
C
      IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).NE.'BEND'.AND.
     1  IHARG(2).NE.'DEFE')GOTO350
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'INTE')GOTO363
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'SLOP')GOTO364
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'RESS')GOTO365
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'CORR')GOTO366
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SN'.AND.IHARG(2).EQ.'SCAL')GOTO493
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'QN'.AND.IHARG(2).EQ.'SCAL')GOTO495
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(2).EQ.'SN')GOTO371
      IF(IHARG(2).EQ.'S/N')GOTO371
      IF(IHARG(2).EQ.'SN0')GOTO371
      IF(IHARG(2).EQ.'S/N0')GOTO371
      IF(IHARG(2).EQ.'SNT')GOTO371
      IF(IHARG(2).EQ.'S/NT')GOTO371
      IF(IHARG(2).EQ.'SN+')GOTO372
      IF(IHARG(2).EQ.'S/N+')GOTO372
      IF(IHARG(2).EQ.'SNL')GOTO372
      IF(IHARG(2).EQ.'SN-')GOTO373
      IF(IHARG(2).EQ.'S/N-')GOTO373
      IF(IHARG(2).EQ.'SNS')GOTO373
      IF(IHARG(2).EQ.'SN00')GOTO374
      IF(IHARG(2).EQ.'SNT2')GOTO374
      IF(IHARG(2).EQ.'S/N2')GOTO374
      IF(IHARG(2).EQ.'SN2')GOTO374
  139 CONTINUE
C
      IF(IHARG(1).EQ.'SN')GOTO381
      IF(IHARG(1).EQ.'S/N')GOTO381
      IF(IHARG(1).EQ.'SN0')GOTO381
      IF(IHARG(1).EQ.'S/N0')GOTO381
      IF(IHARG(1).EQ.'SNT')GOTO381
      IF(IHARG(1).EQ.'S/NT')GOTO381
      IF(IHARG(1).EQ.'SN+')GOTO382
      IF(IHARG(1).EQ.'S/N+')GOTO382
      IF(IHARG(1).EQ.'SNL ')GOTO382
      IF(IHARG(1).EQ.'SN-')GOTO383
      IF(IHARG(1).EQ.'S/N-')GOTO383
      IF(IHARG(1).EQ.'SNS')GOTO383
      IF(IHARG(1).EQ.'SN00')GOTO384
      IF(IHARG(1).EQ.'SNT2')GOTO384
      IF(IHARG(1).EQ.'S/N2')GOTO384
      IF(IHARG(1).EQ.'SN2')GOTO384
C
      IF(IHARG(1).EQ.'CP')GOTO401
      IF(IHARG(1).EQ.'CPK')GOTO402
      IF(IHARG(1).EQ.'CNPK')GOTO398
      IF(IHARG(1).EQ.'CPM')GOTO400
      IF(IHARG(1).EQ.'CC')GOTO399
      IF(IHARG(1).EQ.'CPL')GOTO396
      IF(IHARG(1).EQ.'CPU')GOTO397
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'DEFE')GOTO403
         IF(IHARG(1).EQ.'EXPE'.AND.IHARG(2).EQ.'LOSS')GOTO404
      ENDIF
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'NORM'.AND.IHARG(2).EQ.'PPCC')GOTO411
      ENDIF
C
      IF(IHARG(1).EQ.'EXTR')GOTO412
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HARM'.AND.IHARG(2).EQ.'MEAN')GOTO446
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'IQ  '.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'LOCA')GOTO457
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'SCAL')GOTO458
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'VARI')GOTO459
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'SD')GOTO460
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'DEVI')
     1GOTO461
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'COVA')GOTO462
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'CORR')GOTO463
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDV')GOTO464
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.
     1IHARG(2).EQ.'MIDC'.AND.IHARG2(2).EQ.'ORRE')GOTO471
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDC')GOTO465
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'MIDV')
     1GOTO466
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'CORR')
     1GOTO472
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HODG'.AND.IHARG(2).EQ.'LEHM')GOTO467
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'QUAN'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')
     1GOTO468
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'QUAN')GOTO469
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'ERRO')
     1GOTO470
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'MEAN')GOTO486
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'SD')GOTO490
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO491
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'TRIM'.AND.
     1IHARG(3).EQ.'MEAN')GOTO492
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIFF'.AND.IHARG(2).EQ.'OF')THEN
        IF(IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO623
        IF(IHARG(3).EQ.'AAD')GOTO523
        IF(IHARG(3).EQ.'MEAN' .OR. IHARG(3).EQ.'AVER')GOTO501
        IF(IHARG(3).EQ.'MIDM')GOTO502
        IF(IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO624
        IF(IHARG(3).EQ.'MAD')GOTO524
        IF(IHARG(3).EQ.'MEDI')GOTO503
        IF(IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN')GOTO504
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')GOTO505
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')GOTO506
        IF(IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')GOTO507
        IF(IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO508
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')GOTO509
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO738
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO638
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'MEAN')GOTO538
        IF(IHARG(3).EQ.'SD')GOTO520
        IF(IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI')GOTO521
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO740
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO640
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'MEAN')GOTO540
        IF(IHARG(3).EQ.'VARI')GOTO522
        IF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'IQ  '.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO626
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD')GOTO526
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'VARI')GOTO527
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')GOTO528
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')GOTO529
        IF(IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND.
     1     IHARG(5).EQ.'MIDV')GOTO530
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO631
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD')GOTO531
        IF(IHARG(3).EQ.'RANG')GOTO532
        IF(IHARG(3).EQ.'MIDR')GOTO533
        IF(IHARG(3).EQ.'QUAN')GOTO534
        IF(IHARG(3).EQ.'SKEW')GOTO535
        IF(IHARG(3).EQ.'KURT')GOTO536
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'SD')GOTO537
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VARI')GOTO539
        IF(IHARG(3).EQ.'MINI')GOTO541
        IF(IHARG(3).EQ.'MAXI')GOTO542
        IF(IHARG(3).EQ.'EXTR')GOTO543
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'VARI')GOTO554
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'VARI')GOTO544
        IF(IHARG(3).EQ.'SN'.AND.IHARG(4).EQ.'SCAL')GOTO645
        IF(IHARG(3).EQ.'SN')GOTO545
        IF(IHARG(3).EQ.'QN'.AND.IHARG(4).EQ.'SCAL')GOTO646
        IF(IHARG(3).EQ.'QN')GOTO546
        IF(IHARG(3).EQ.'SUM')GOTO551
        IF(IHARG(3).EQ.'SUMS')GOTO551
CCCCC   SIZE MAKES NO SENSE IN THIS CONTEXT (GROUP SIZE ARE EQUAL
CCCCC   FOR BOTH VARIABLES, SO ALWAYS ZERO)
CCCCC   IF(IHARG(3).EQ.'SIZE')GOTO552
CCCCC   IF(IHARG(3).EQ.'NUMB')GOTO552
CCCCC   IF(IHARG(3).EQ.'COUN')GOTO552
      ENDIF
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'RATI')GOTO553
C
      IFOUND='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASPL.  **
C               **********************
C
  200 CONTINUE
      ICASPL='COUN'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO700
C
  201 CONTINUE
      ICASPL='NUMB'
      IYVAR='OFF'
      GOTO701
C
  202 CONTINUE
      ICASPL='NUMB'
      IYVAR='OFF'
      GOTO702
C
  211 CONTINUE
      ICASPL='SUM'
      GOTO701
C
  212 CONTINUE
      ICASPL='PROD'
      GOTO701
C
  213 CONTINUE
      ICASPL='INTE'
      GOTO701
C
  221 CONTINUE
      ICASPL='MIDR'
      GOTO701
C
  222 CONTINUE
      ICASPL='MEAN'
      GOTO701
C
  223 CONTINUE
      ICASPL='MIDM'
      GOTO701
C
  224 CONTINUE
      ICASPL='MEDI'
      GOTO701
C
  225 CONTINUE
      ICASPL='TRIM'
      GOTO702
C
  226 CONTINUE
      ICASPL='WINM'
      GOTO702
C
  241 CONTINUE
      ICASPL='RANG'
      GOTO701
C
  242 CONTINUE
      ICASPL='MINI'
      GOTO701
C
  243 CONTINUE
      ICASPL='MAXI'
      GOTO701
C
  251 CONTINUE
      ICASPL='VAME'
      GOTO704
C
  252 CONTINUE
      ICASPL='VAME'
      GOTO703
C
  253 CONTINUE
      ICASPL='VAME'
      GOTO702
C
  254 CONTINUE
      ICASPL='VARI'
      GOTO701
C
  261 CONTINUE
      ICASPL='SDME'
      GOTO705
C
  262 CONTINUE
      ICASPL='SDME'
      GOTO704
C
  263 CONTINUE
      ICASPL='SDME'
      GOTO703
C
  264 CONTINUE
      ICASPL='SD'
      GOTO702
C
  265 CONTINUE
      ICASPL='SD'
      GOTO701
C
  266 CONTINUE
      ICASPL='SDME'
      GOTO702
C
  271 CONTINUE
      ICASPL='RESD'
      GOTO701
C
  272 CONTINUE
      ICASPL='REVA'
      GOTO701
C
  273 CONTINUE
      ICASPL='CVAR'
      GOTO703
C
  274 CONTINUE
      ICASPL='CVAR'
      GOTO702
C
  276 CONTINUE
      ICASPL='RESD'
      GOTO702
C
  277 CONTINUE
      ICASPL='RESD'
      GOTO703
C
  278 CONTINUE
      ICASPL='REVA'
      GOTO702
C
  301 CONTINUE
      ICASPL='LOWQ'
      GOTO702
C
  302 CONTINUE
      ICASPL='MIDQ'
      GOTO702
C
  303 CONTINUE
      ICASPL='UPPQ'
      GOTO702
C
  304 CONTINUE
      ICASPL='LOWH'
      GOTO702
C
  305 CONTINUE
      ICASPL='UPPH'
      GOTO702
C
  311 CONTINUE
      ICASPL='SKEW'
      GOTO704
C
  312 CONTINUE
      ICASPL='SKEW'
      GOTO701
C
  313 CONTINUE
      ICASPL='KURT'
      GOTO704
C
  314 CONTINUE
      ICASPL='KURT'
      GOTO701
C
  321 CONTINUE
      ICASPL='AUCV'
      GOTO701
C
  322 CONTINUE
      ICASPL='AUCR'
      GOTO701
C
  331 CONTINUE
      ICASPL='COVA'
      IXVAR='ON'
      GOTO701
C
  332 CONTINUE
      ICASPL='CORR'
      IXVAR='ON'
      GOTO701
C
  333 CONTINUE
      ICASPL='RACV'
      IXVAR='ON'
      GOTO702
C
  334 CONTINUE
      ICASPL='RACR'
      IXVAR='ON'
      GOTO702
C
  335 CONTINUE
      ICASPL='COMO'
      IXVAR='ON'
      GOTO701
C
  336 CONTINUE
      ICASPL='RACO'
      IXVAR='ON'
      GOTO702
C
  337 CONTINUE
      ICASPL='KTAU'
      IXVAR='ON'
      GOTO702
C
  341 CONTINUE
      ICASPL='1DEC'
      GOTO702
C
  342 CONTINUE
      ICASPL='2DEC'
      GOTO702
C
  343 CONTINUE
      ICASPL='3DEC'
      GOTO702
C
  344 CONTINUE
      ICASPL='4DEC'
      GOTO702
C
  345 CONTINUE
      ICASPL='5DEC'
      GOTO702
C
  346 CONTINUE
      ICASPL='6DEC'
      GOTO702
C
  347 CONTINUE
      ICASPL='7DEC'
      GOTO702
C
  348 CONTINUE
      ICASPL='8DEC'
      GOTO702
C
  349 CONTINUE
      ICASPL='9DEC'
      GOTO702
C
  350 CONTINUE
      ICASPL='PERC'
      GOTO701
C
  361 CONTINUE
      ICASPL='SIFR'
      GOTO702
C
  362 CONTINUE
      ICASPL='SIAM'
      GOTO702
C
  363 CONTINUE
      ICASPL='LIIN'
      IXVAR='ON'
      GOTO702
C
  364 CONTINUE
      ICASPL='LISL'
      IXVAR='ON'
      GOTO702
C
  365 CONTINUE
      ICASPL='LIRE'
      IXVAR='ON'
      GOTO702
C
  366 CONTINUE
      ICASPL='LICO'
      IXVAR='ON'
      GOTO702
C
  371 CONTINUE
      ICASPL='SN0'
      GOTO702
C
  372 CONTINUE
      ICASPL='SN+'
      GOTO702
C
  373 CONTINUE
      ICASPL='SN-'
      GOTO702
C
  374 CONTINUE
      ICASPL='SN00'
      GOTO702
C
  381 CONTINUE
      ICASPL='SN0'
      GOTO701
C
  382 CONTINUE
      ICASPL='SN+'
      GOTO701
C
  383 CONTINUE
      ICASPL='SN-'
      GOTO701
C
  384 CONTINUE
      ICASPL='SN00'
      GOTO701
C
  396 CONTINUE
      ICASPL='CPL'
      GOTO701
C
  397 CONTINUE
      ICASPL='CPU'
      GOTO701
C
  398 CONTINUE
      ICASPL='CNPK'
      GOTO701
C
  399 CONTINUE
      ICASPL='CC'
      GOTO701
C
  400 CONTINUE
      ICASPL='CPM'
      GOTO701
C
  401 CONTINUE
      ICASPL='CP'
      GOTO701
C
  402 CONTINUE
      ICASPL='CPK'
      GOTO701
C
  403 CONTINUE
      ICASPL='PEDE'
      GOTO702
C
  404 CONTINUE
      ICASPL='EXLO'
      GOTO702
C
  411 CONTINUE
      ICASPL='NOPP'
      GOTO702
C
  412 CONTINUE
      ICASPL='EXTR'
      GOTO701
C
  413 CONTINUE
      ICASPL='AAD '
      GOTO703
C
  414 CONTINUE
      ICASPL='AAD '
      GOTO701
C
  415 CONTINUE
      ICASPL='MAD '
      GOTO703
C
  416 CONTINUE
      ICASPL='MAD '
      GOTO701
C
  426 CONTINUE
      ICASPL='GEME'
      GOTO702
C
  436 CONTINUE
      ICASPL='GESD'
      GOTO703
C
  446 CONTINUE
      ICASPL='HAME'
      GOTO702
C
  456 CONTINUE
      ICASPL='IQRA'
      GOTO702
C
  457 CONTINUE
      ICASPL='BILO'
      GOTO702
C
  458 CONTINUE
      ICASPL='BISC'
      GOTO702
C
  459 CONTINUE
      ICASPL='WIVA'
      GOTO702
C
  460 CONTINUE
      ICASPL='WISD'
      GOTO702
C
  461 CONTINUE
      ICASPL='WISD'
      GOTO703
C
  462 CONTINUE
      ICASPL='WICV'
      IXVAR='ON'
      GOTO702
C
  463 CONTINUE
      ICASPL='WICR'
      IXVAR='ON'
      GOTO702
C
  464 CONTINUE
      ICASPL='BIMV'
      GOTO702
C
  465 CONTINUE
      ICASPL='BIMC'
      IXVAR='ON'
      GOTO702
C
  466 CONTINUE
      ICASPL='PBMV'
      GOTO703
C
  467 CONTINUE
      ICASPL='HLEH'
      GOTO702
C
  468 CONTINUE
      ICASPL='QUSE'
      GOTO703
C
  469 CONTINUE
      ICASPL='QUAN'
      GOTO701
C
  470 CONTINUE
      ICASPL='TMSE'
      GOTO704
C
  471 CONTINUE
      ICASPL='BICR'
      IXVAR='ON'
      GOTO702
C
  472 CONTINUE
      ICASPL='PBCR'
      GOTO703
C
  486 CONTINUE
      ICASPL='WEME'
      IXVAR='ON'
      GOTO702
C
  488 CONTINUE
      ICASPL='WEVA'
      IXVAR='ON'
      GOTO702
C
  490 CONTINUE
      ICASPL='WESD'
      IXVAR='ON'
      GOTO702
C
  491 CONTINUE
      ICASPL='WESD'
      IXVAR='ON'
      GOTO703
C
  492 CONTINUE
      ICASPL='WETM'
      IXVAR='ON'
      GOTO703
C
  493 CONTINUE
      ICASPL='SNSC'
      GOTO702
C
  495 CONTINUE
      ICASPL='QNSC'
      GOTO702
C
  501 CONTINUE
      ICASPL='DMEA'
      IXVAR='ON'
      GOTO703
C
  502 CONTINUE
      ICASPL='DMDM'
      IXVAR='ON'
      GOTO703
C
  503 CONTINUE
      ICASPL='DMED'
      IXVAR='ON'
      GOTO703
C
  504 CONTINUE
      ICASPL='DTRM'
      IXVAR='ON'
      GOTO704
C
  505 CONTINUE
      ICASPL='DWNM'
      IXVAR='ON'
      GOTO704
C
  506 CONTINUE
      ICASPL='DGEO'
      IXVAR='ON'
      GOTO704
C
  507 CONTINUE
      ICASPL='DHAR'
      IXVAR='ON'
      GOTO704
C
  508 CONTINUE
      ICASPL='DHDL'
      IXVAR='ON'
      GOTO704
C
  509 CONTINUE
      ICASPL='DBIW'
      IXVAR='ON'
      GOTO704
C
  520 CONTINUE
      ICASPL='DSD '
      IXVAR='ON'
      GOTO703
C
  521 CONTINUE
      ICASPL='DSD '
      IXVAR='ON'
      GOTO704
C
  522 CONTINUE
      ICASPL='DVAR'
      IXVAR='ON'
      GOTO703
C
  623 CONTINUE
      ICASPL='DAAD'
      IXVAR='ON'
      GOTO705
C
  523 CONTINUE
      ICASPL='DAAD'
      IXVAR='ON'
      GOTO703
C
  624 CONTINUE
      ICASPL='MAAD'
      IXVAR='ON'
      GOTO705
C
  524 CONTINUE
      ICASPL='DMAD'
      IXVAR='ON'
      GOTO703
C
  525 CONTINUE
      ICASPL='DIQR'
      IXVAR='ON'
      GOTO704
C
  626 CONTINUE
      ICASPL='DWSD'
      IXVAR='ON'
      GOTO705
C
  526 CONTINUE
      ICASPL='DWSD'
      IXVAR='ON'
      GOTO704
C
  527 CONTINUE
      ICASPL='DWVA'
      IXVAR='ON'
      GOTO704
C
  528 CONTINUE
      ICASPL='DBIM'
      IXVAR='ON'
      GOTO704
C
  529 CONTINUE
      ICASPL='DBIS'
      IXVAR='ON'
      GOTO704
C
  530 CONTINUE
      ICASPL='DPBN'
      IXVAR='ON'
      GOTO705
C
  631 CONTINUE
      ICASPL='DGSD'
      IXVAR='ON'
      GOTO705
C
  531 CONTINUE
      ICASPL='DGSD'
      IXVAR='ON'
      GOTO704
C
  532 CONTINUE
      ICASPL='DRAN'
      IXVAR='ON'
      GOTO703
C
  533 CONTINUE
      ICASPL='DMDR'
      IXVAR='ON'
      GOTO703
C
  534 CONTINUE
      ICASPL='DQUA'
      IXVAR='ON'
      GOTO703
C
  535 CONTINUE
      ICASPL='DSKE'
      IXVAR='ON'
      GOTO703
C
  536 CONTINUE
      ICASPL='DKUR'
      IXVAR='ON'
      GOTO703
C
  537 CONTINUE
      ICASPL='DRSD'
      IXVAR='ON'
      GOTO704
C
  738 CONTINUE
      ICASPL='DSDM'
      IXVAR='ON'
      GOTO706
C
  638 CONTINUE
      ICASPL='DSDM'
      IXVAR='ON'
      GOTO705
C
  538 CONTINUE
      ICASPL='DSDM'
      IXVAR='ON'
      GOTO704
C
  539 CONTINUE
      ICASPL='DRVA'
      IXVAR='ON'
      GOTO704
C
  740 CONTINUE
      ICASPL='DVAM'
      IXVAR='ON'
      GOTO706
C
  640 CONTINUE
      ICASPL='DVAM'
      IXVAR='ON'
      GOTO705
C
  540 CONTINUE
      ICASPL='DVAM'
      IXVAR='ON'
      GOTO704
C
  541 CONTINUE
      ICASPL='DMIN'
      IXVAR='ON'
      GOTO703
C
  542 CONTINUE
      ICASPL='DMAX'
      IXVAR='ON'
      GOTO703
C
  543 CONTINUE
      ICASPL='DEXT'
      IXVAR='ON'
      GOTO703
C
  554 CONTINUE
      ICASPL='DCVA'
      IXVAR='ON'
      GOTO705
C
  544 CONTINUE
      ICASPL='DCVA'
      IXVAR='ON'
      GOTO704
C
  645 CONTINUE
      ICASPL='DSN'
      IXVAR='ON'
      GOTO704
C
  545 CONTINUE
      ICASPL='DSN'
      IXVAR='ON'
      GOTO703
C
  646 CONTINUE
      ICASPL='DQN'
      IXVAR='ON'
      GOTO704
C
  546 CONTINUE
      ICASPL='DQN'
      IXVAR='ON'
      GOTO703
C
  551 CONTINUE
      ICASPL='DSUM'
      IXVAR='ON'
      GOTO703
C
  552 CONTINUE
      IXVAR='ON'
      ICASPL='DCOU'
      GOTO703
C
  553 CONTINUE
      ICASPL='RATI'
      IXVAR='ON'
      GOTO701
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DETERMINE THE LOCATION     (IN IHARG(.))       **
C               **  OF THE WORD      PLOT                          **
C               **  PLACE IT IN    ILASTC                          **
C               *****************************************************
C
  700 CONTINUE
      IF(NUMARG.LT.1)GOTO780
      IF(IHARG(1).EQ.'PLOT')GOTO800
      GOTO780
C
  701 CONTINUE
      IF(NUMARG.LT.2)GOTO780
      IF(IHARG(2).EQ.'PLOT')GOTO801
      GOTO780
C
  702 CONTINUE
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(3).EQ.'PLOT')GOTO802
      GOTO780
C
  703 CONTINUE
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(4).EQ.'PLOT')GOTO803
      GOTO780
C
  704 CONTINUE
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(5).EQ.'PLOT')GOTO804
      GOTO780
C
  705 CONTINUE
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(6).EQ.'PLOT')GOTO805
      GOTO780
C
  706 CONTINUE
      IF(NUMARG.LT.7)GOTO780
      IF(IHARG(7).EQ.'PLOT')GOTO806
      GOTO780
C
  780 CONTINUE
      IFOUND='NO'
      ICASPL='UNKN'
      GOTO9000
C
  800 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  801 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  802 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  803 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  804 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  805 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  806 CONTINUE
      ILASTC=7
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  890 CONTINUE
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 21--                                       **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 22--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL 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)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1WRITE(ICOUT,2211)IHLEFT,ICOLL,NLEFT
 2211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL DPWRST('XXX','BUG ')
C
C               ******************************************************
C               **  STEP 23--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.       **
C               ******************************************************
C
      ISTEPN='23'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO2390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPCRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      (FOR WHICH A CROSS TABULATE ... PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)MINN2
 2315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)
 2317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2318)(IANS(I),I=1,MIN(80,IWIDTH))
 2318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               *****************************************
C               **  STEP 24--                          **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='24'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2480
      DO2400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2420
 2400 CONTINUE
      GOTO2490
 2410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2490
 2420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2490
C
 2480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2481)
 2481 FORMAT('***** INTERNAL ERROR IN DPCRPL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2482)
 2482 FORMAT('      AT BRANCH POINT 2481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2483)
 2483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2484)
 2484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2485)NUMARG
 2485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2486)
 2486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2487)(IANS(I),I=1,IWIDTH)
 2487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DPCRPL')GOTO2495
      WRITE(ICOUT,2491)NUMARG,ILOCQ,ICASEQ
 2491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 2495 CONTINUE
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
C               ******************************************************
C               **  STEP 25--                                       **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST VARIABLE ARE TO BE GROUPED                **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;         **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE        **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,           **
C               **  STANDARD DEVIATIONS, RANGES, AND                **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.             **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,
C               **  ETC.  IN THE RESULTING STATISTIC PLOT.           **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                   **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.          **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                 **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='25'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(IYVAR.EQ.'OFF'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=2
        ITAG1=1
        ITAG2=2
        IY=0
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=3
        ITAG1=2
        ITAG2=3
        IY=1
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'ON')THEN
        NUMEXP=4
        ITAG1=3
        ITAG2=4
        IY=1
        IX=2
      ELSE
        NUMEXP=2
        ITAG1=1
        ITAG2=2
        IY=0
        IX=0
      ENDIF
C
 2510 CONTINUE
      IF(NUMEXP.NE.NUMV2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2511)
 2511   FORMAT('***** ERROR IN DPCRPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2512)
 2512   FORMAT('      FOR THIS CROSS TABULATE ... PLOT, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2518)NUMEXP
 2518   FORMAT('      THE EXPECTED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2520)
 2520   FORMAT('      SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2521)NUMV2
 2521   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2523)
 2523   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2524)(IANS(I),I=1,MIN(80,IWIDTH))
 2524   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NPTS=NLEFT
      IF(IYVAR.EQ.'ON')THEN
        IHLEFT=IHARG(IY)
        IHLEF2=IHARG2(IY)
        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)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1    WRITE(ICOUT,2541)IHLEFT,ICOLL,NLEFT
 2541   FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1    CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IXVAR.EQ.'ON')THEN
        IHX=IHARG(IX)
        IHX2=IHARG2(IX)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHX,IHX2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLX=IVALUE(ILOCV)
        NX=IN(ILOCV)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1    WRITE(ICOUT,2546)IHX,ICOLX,NX
 2546   FORMAT('IHX,ICOLX,NX   = ',A4,I8,I8)
        IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1    CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IHHOR=IHARG(ITAG1)
      IHHOR2=IHARG2(ITAG1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1  WRITE(ICOUT,2551)IHHOR,ICOLH,NHOR
 2551 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1  CALL DPWRST('XXX','BUG ')
C
      IHHR2=IHARG(ITAG2)
      IHHR22=IHARG2(ITAG2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHR2,IHHR22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH2=IVALUE(ILOCV)
      NHOR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1  WRITE(ICOUT,2561)IHHR2,ICOLH2,NHOR2
 2561 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1  CALL DPWRST('XXX','BUG ')
C
      IF(IXVAR.EQ.'ON'.AND.NX.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2571)
 2571   FORMAT('***** ERROR IN DPCRPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2572)
 2572   FORMAT('      FOR A CROSS TABULATE ... PLOT, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2573)NX
 2573   FORMAT('      THE NUMER OF POINTS FOR THE X VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2574)NPTS
 2574   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2575)IHX,IHX2,NX
 2575   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2577)
 2577   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2578)(IANS(I),I=1,MIN(IWIDTH,80))
 2578   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NHOR.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2581)
 2581   FORMAT('***** ERROR IN DPCRPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2582)
 2582   FORMAT('      FOR A CROSS TABULATE ... PLOT, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2583)NHOR
 2583   FORMAT('      THE NUMER OF POINTS FOR THE FIRST GROUP ',
     1         'VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2584)NPTS
 2584   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2585)IHHOR,IHHOR2,NHOR
 2585   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2587)
 2587   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2588)(IANS(I),I=1,MIN(IWIDTH,80))
 2588   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NHOR2.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2591)
 2591   FORMAT('***** ERROR IN DPCRPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2592)
 2592   FORMAT('      FOR A CROSS TABULATE ... PLOT, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2593)NHOR2
 2593   FORMAT('      THE NUMER OF POINTS FOR THE SECOND GROUP ',
     1         'VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2594)NPTS
 2594   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2595)IHHR2,IHHR22,NHOR2
 2595   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2597)
 2597   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)WRITE(ICOUT,2598)(IANS(I),I=1,MIN(IWIDTH,80))
 2598   FORMAT('      ',80A1)
        IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************************
C               **  STEP 26--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='26'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IYVAR.EQ.'OFF')THEN
        Y1(J)=0.0
      ELSE
        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)
      ENDIF
C
      IJ=MAXN*(ICOLX-1)+I
      IF(IXVAR.EQ.'OFF')THEN
        Z1(J)=0.0
      ELSE
        IF(ICOLX.LE.MAXCOL)Z1(J)=V(IJ)
        IF(ICOLX.EQ.MAXCP1)Z1(J)=PRED(I)
        IF(ICOLX.EQ.MAXCP2)Z1(J)=RES(I)
        IF(ICOLX.EQ.MAXCP3)Z1(J)=YPLOT(I)
        IF(ICOLX.EQ.MAXCP4)Z1(J)=XPLOT(I)
        IF(ICOLX.EQ.MAXCP5)Z1(J)=X2PLOT(I)
        IF(ICOLX.EQ.MAXCP6)Z1(J)=TAGPLO(I)
      ENDIF
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOLH2-1)+I
      IF(ICOLH2.LE.MAXCOL)X2(J)=V(IJ)
      IF(ICOLH2.EQ.MAXCP1)X2(J)=PRED(I)
      IF(ICOLH2.EQ.MAXCP2)X2(J)=RES(I)
      IF(ICOLH2.EQ.MAXCP3)X2(J)=YPLOT(I)
      IF(ICOLH2.EQ.MAXCP4)X2(J)=XPLOT(I)
      IF(ICOLH2.EQ.MAXCP5)X2(J)=X2PLOT(I)
      IF(ICOLH2.EQ.MAXCP6)X2(J)=TAGPLO(I)
C
 2660 CONTINUE
      NLOCAL=J
C
C               ******************************************************
C               **  STEP 28--                                       **
C               **  COMPUTE THE APPROPRIATE STATISTIC PLOT STATISTIC--
C               **  (MEAN, STANDARD DEVIATION, RANGE, OR CUSUM).    **
C               **  COMPUTE CONFIDENCE LINES.                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS           **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.              **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S     **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,*
C               **  AND THE UPPER CONFIDENCE LINE.                  **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).   **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).   **
C               ******************************************************
C
      ISTEPN='28'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPCRPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPCRP2(Y1,Z1,X1,X2,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,XTEMP3,XTEMP4,MAXNXT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ICTBDI,
     1IQUAME,IQUASE,
     1Y,X,D,X3D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
      IF(ICASPL.EQ.'COUN')THEN
        ICASPL='CTCO'
      ELSE
        IF(ICTBDI.EQ.'2')THEN
          ICASPL='CTA2'
        ELSE
          ICASPL='CTAB'
        ENDIF
      ENDIF
C
C
C               *************************************************
C               **  STEP 29--                                  **
C               **  SAVE DIFFERENCE BETWEEN HIGHEST VALUE AND  **
C               **  LOWEST VALUE OF STATISTIC IN INTERNAL      **
C               **  PARAMETER ALOWHIGH                         **
C               *************************************************
      AMINS=CPUMAX
      AMAXS=CPUMIN
      DO2910I=1,NPLOTP
        IF(D(I).NE.1.0)GOTO2910
        IF(Y(I).GT.AMAXS)AMAXS=Y(I)
        IF(Y(I).LT.AMINS)AMINS=Y(I)
 2910 CONTINUE
      ADIFF=0.0
      IF(AMINS.NE.CPUMAX.AND.AMAXS.NE.CPUMIN)ADIFF=AMAXS-AMINS
C
      ISUBN0='DPCRPL'
C
      IH='ALOW'
      IH2='HIGH'
      VALUE0=ADIFF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'CRPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
 9012 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ISIZE
 9015 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMV2
 9016 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
 9017 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.2)WRITE(ICOUT,9018)IHHOR,IHHOR2,ICOLH,NHOR
 9018 FORMAT('IHHOR,IHHOR2,ICOLH,NHOR = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.3)WRITE(ICOUT,9019)IHX,IHX2,ICOLX,NX
 9019 FORMAT('IHX,IHX2,ICOLX,NX = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.3)CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED SEPTEMBER 1992
CCCCC IF(NPLOTP.LE.0)GOTO9090
      IF(IFOUND.EQ.'NO'.OR.NPLOTP.LE.0)GOTO9090
      DO9025I=1,NPLOTP
      WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
 9026 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCRP2(Y,Z,TAG1,TAG2,N,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMPZ,XIDTEM,XIDTE2,XTEMP1,XTEMP2,XTEMP4,MAXNXT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ICTBDI,
     1IQUAME,IQUASE,
     1Y2,X2,D2,X3D,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A PLOT
C              OF THE FOLLOWING TYPES--
C                 MEAN CROSS TABULATE PLOT
C                 MIDM CROSS TABULATE PLOT
C                 MEDI CROSS TABULATE PLOT
C                 SD CROSS TABULATE PLOT
C                 REL SD CROSS TABULATE PLOT
C                 SD MEAN CROSS TABULATE PLOT
C                 VARI CROSS TABULATE PLOT
C                 REL VARI CROSS TABULATE PLOT
C                 VARI MEAN CROSS TABULATE PLOT
C                 RANG CROSS TABULATE PLOT
C                 MINI CROSS TABULATE PLOT
C                 MAXI CROSS TABULATE PLOT
C                 EXTREME CROSS TABULATE PLOT
C                 SKEW CROSS TABULATE PLOT
C                 KURT CROSS TABULATE PLOT
C                 AUCR CROSS TABULATE PLOT
C                 SDM CROSS TABULATE PLOT
C                 AUCV CROSS TABULATE PLOT
C                 RACV CROSS TABULATE PLOT
C                 LOWH CROSS TABULATE PLOT
C                 UPPH CROSS TABULATE PLOT
C                 LOWQ CROSS TABULATE PLOT
C                 UPPQ CROSS TABULATE PLOT
C                 TRIM CROSS TABULATE PLOT
C                 WINM CROSS TABULATE PLOT
C                 MIDQ CROSS TABULATE PLOT
C                 1DEC CROSS TABULATE PLOT
C                 2DEC CROSS TABULATE PLOT
C                 3DEC CROSS TABULATE PLOT
C                 4DEC CROSS TABULATE PLOT
C                 5DEC CROSS TABULATE PLOT
C                 6DEC CROSS TABULATE PLOT
C                 7DEC CROSS TABULATE PLOT
C                 8DEC CROSS TABULATE PLOT
C                 9DEC CROSS TABULATE PLOT
C                 SIN FREQUENCY CROSS TABULATE PLOT
C                 SIN AMPLITUDE CROSS TABULATE PLOT
C                 LINEAR INTERCEPT CROSS TABULATE PLOT
C                 LINEAR SLOPE CROSS TABULATE PLOT
C                 LINEAR RESSD CROSS TABULATE PLOT
C                 LINEAR CORRELATION CROSS TABULATE PLOT
C                 TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 CP PLOT
C                 CPK PLOT
C                 CNPK PLOT
C                 CPM PLOT
C                 CC PLOT
C                 PERCENT DEFECTIVE PLOT
C                 EXPECTED LOSS PLOT
C                 NORM PPCC CROSS TABULATE PLOT
C                 AAD CROSS TABULATE PLOT
C                 MAD CROSS TABULATE PLOT
C                 SN CROSS TABULATE PLOT
C                 QN CROSS TABULATE PLOT
C                 PERCENTILE CROSS TABULATE PLOT
C                 GEOMETRIC MEAN CROSS TABULATE PLOT
C                 GEOMETRIC STANDARD DEVIATION CROSS TABULATE PLOT
C                 BIWEIGHT LOCATION CROSS TABULATE PLOT
C                 BIWEIGHT SCALE CROSS TABULATE PLOT
C                 WINSORIZED VARIANCE CROSS TABULATE PLOT
C                 WINSORIZED SD CROSS TABULATE PLOT
C                 WINSORIZED COVARIANCE CROSS TABULATE PLOT
C                 WINSORIZED CORRELATION CROSS TABULATE PLOT
C                 BIWEIGHT MIDVARIANCE CROSS TABULATE PLOT
C                 BIWEIGHT MIDCOVARIANCE CROSS TABULATE PLOT
C                 BIWEIGHT MIDCORRELATION CROSS TABULATE PLOT
C                 PERCENTAGE BEND MIDVARIANCE CROSS TABULATE PLOT
C                 HODGES LEHMAN CROSS TABULATE PLOT
C                 QUANTILE CROSS TABULATE PLOT
C                 QUANTILE STANDARD ERROR CROSS TABULATE PLOT
C                 TRIMMED MEAN STANDARD ERROR CROSS TABULATE PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C     UPDATED         --JULY      2002. WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C                                           PLOT
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR PLOT
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD ERROR
C                                       PLOT
C     UPDATED         --APRIL     2003. ADD SN AND QN
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL RANGE
      EXTERNAL SUM
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      CHARACTER*4 ICONT
      CHARACTER*4 ICTBDI
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION TAG1(*)
      DIMENSION TAG2(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
      DIMENSION X3D(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XIDTEM(*)
      DIMENSION XIDTE2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP4(*)
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.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='DPCR'
      ISUBN2='P2  '
C
      IWRITE='OFF'
C
      I2=0
      ISIZE2=0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCRP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CRP2')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPCRP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IBUGG3,ISUBRO
   71 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N,ICASPL,ICONT
   72 FORMAT('N,ICASPL,ICONT = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y(I),Z(I),TAG1(I),TAG2(I)
   74 FORMAT('I, Y(I),Z(I),TAG1(I)TAG2(I) = ',I8,4F15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
C               **  FOR THE GROUP VARIABLES (TAG1, TAG2)            **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS           **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE         **
C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.         **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'CRP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSE1,IBUGG3,IERROR)
      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
      CALL DISTIN(TAG2,N,IWRITE,XIDTE2,NUMSE2,IBUGG3,IERROR)
      CALL SORT(XIDTE2,NUMSE2,XIDTE2)
C
      IF(NUMSE1.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,191)
  191   FORMAT('***** ERROR IN DPCRP2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,192)
  192   FORMAT('      NUMBER OF SETS    NUMSE1 = 0 ')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE2.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,193)
  193   FORMAT('***** ERROR IN DPCRP2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,194)
  194   FORMAT('      NUMBER OF SETS    NUMSE2 = 0 ')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE1.EQ.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,195)
  195   FORMAT('***** ERROR IN DPCRP2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,196)NUMSE1
  196   FORMAT('      NUMBER OF SETS FOR GROUP 1 VARIABLE ',I8,
     1         ' IDENTICAL TO ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,197)N
  197   FORMAT('      NUMBER OF OBSERVATIONS ',I8,' .')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE2.EQ.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,195)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,206)NUMSE2
  206   FORMAT('      NUMBER OF SETS FOR GROUP 2 VARIABLE ',I8,
     1         ' IDENTICAL TO ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,197)N
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      AN=N
      ANUMS1=NUMSE1
      ANUMS2=NUMSE2
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  COMPUTE THE SPECIFIED STATISTIC               **
C               **  FOR EACH CROSS-TAB CATEGORY OF THE DATA, AND  **
C               **  THEN FOR THE FULL DATA SET                    **
C               ****************************************************
C
      ISTEPN='11'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'CRP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      ATAG=1.0
C
      AINC=0.4/REAL(NUMSE2)
      ICASP2=ICASPL
      IF(ICASPL.EQ.'COUN')ICASP2='NUMB'
      DO11000ISET1=1,NUMSE1
CCCCC ATAG=ATAG+1.0
      DO12000ISET2=1,NUMSE2
C
        K=0
        ASTRT=XIDTEM(ISET1)-0.2
        DO11011I=1,N
        IF(TAG1(I).EQ.XIDTEM(ISET1).AND.TAG2(I).EQ.XIDTE2(ISET2))THEN
          K=K+1
          TEMP(K)=Y(I)
          TEMPZ(K)=Z(I)
        ENDIF
11011   CONTINUE
        NS2=K
        IF(NS2.LT.1)GOTO12000
        CALL DPCRP3(ICASP2,TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,XTEMP4,
     1              MAXNXT,RIGHT,
     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1              IQUAME,IQUASE,
     1              ISUBRO,IBUGG3,IERROR)
        J=J+1
        IF(ICASPL.NE.'COUN'.AND.ICTBDI.EQ.'1')THEN
          Y2(J)=RIGHT
          X2(J)=ASTRT + REAL(ISET2-1)*AINC
          D2(J)=ATAG
        ELSE
          Y2(J)=REAL(XIDTE2(ISET2))
          X2(J)=REAL(XIDTEM(ISET1))
          X3D(J)=RIGHT
CCCCC     D2(J)=RIGHT
          D2(J)=1.0
        ENDIF
12000 CONTINUE
11000 CONTINUE
C
      IF(ICASPL.EQ.'COUN')GOTO13000
      IF(ICTBDI.EQ.'2')GOTO13000
      ATAG=2.0
      DO10500ISET1=1,NUMSE1
        K=0
        DO10550I=1,N
          IF(TAG1(I).EQ.XIDTEM(ISET1))THEN
            K=K+1
            TEMP(K)=Y(I)
            TEMPZ(K)=Z(I)
          ENDIF
10550   CONTINUE
        NS2=K
        IF(NS2.LT.1)GOTO10500
        CALL DPCRP3(ICASPL,TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,XTEMP4,
     1              MAXNXT,RIGHT,
     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1              IQUAME,IQUASE,
     1              ISUBRO,IBUGG3,IERROR)
        J=J+1
        ATAG=ATAG+1.0
        Y2(J)=RIGHT
        X2(J)=XIDTEM(ISET1)-0.2
        D2(J)=ATAG
        J=J+1
        Y2(J)=RIGHT
        X2(J)=XIDTEM(ISET1)+0.2
        D2(J)=ATAG
10500 CONTINUE
C
      DO10100I=1,N
        TEMP(I)=Y(I)
        TEMPZ(I)=Z(I)
10100 CONTINUE
      NS2=N
      CALL DPCRP3(ICASPL,TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,XTEMP4,
     1            MAXNXT,RIGHT,
     1            ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1            IQUAME,IQUASE,
     1            ISUBRO,IBUGG3,IERROR)
      ATAG=2.0
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(1)-0.2
      D2(J)=ATAG
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(NUMSE1)+0.2
      D2(J)=ATAG
C
13000 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CRP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCRP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO
 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,N,NUMSE1,NUMSE2,N2,IERROR
 9013 FORMAT('ICASPL,N,NUMSE1,NUMSE2,N2,IERROR = ',A4,4I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCRP3(ICASPL,TEMP,TEMPZ,NS2,XTEMP1,XTEMP2,XTEMP4,
     1MAXNXT,
     1RIGHT,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--FOR CROSS-TABULATE PLOT, GENERATE VALUE OF
C              STATISTIC.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C     UPDATED         --AUGUST    2002. USE "CMPSTA" TO COMPUTE THE
C                                       DESIRED STATISTIC
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IHP
CCCCC CHARACTER*4 IHP2
CCCCC CHARACTER*4 IHWUSE
CCCCC CHARACTER*4 MESSAG
C
      CHARACTER*4 IWRITE
CCCCC CHARACTER*4 IFLAG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
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='DPCR'
      ISUBN2='P3  '
C
      IWRITE='OFF'
C
      CALL CMPSTA(
     1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP4,MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1RIGHT,
     1ISUBRO,IBUGG3,IERROR)
C
C     ---------------------------
C
79000 CONTINUE
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'CRP3')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCRP3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO
 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,NS2,IERROR
 9013 FORMAT('ICASPL,NS2,IERROR = ',A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NS2
      WRITE(ICOUT,9021)I,TEMP(I),TEMPZ(I)
 9021 FORMAT('I,TEMP(I),TEMPZ(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCRTA(Y1,X1,X2,MAXNXT,
     1ISEED,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 KINDS OF CROSS-TABULATIONS--
C              1) MEAN;
C              2) RANGE;
C              3) STANDARD DEVIATION;
C              4) COUNTS;
C              5) SUMS;
C              6) CHI-SQUARE ANALYSIS
C     NOTE   --COMMAND UPGRADED AUGUST 2002 TO SUPPORT FULL RANGE OF
C              SUPPORTED STATISTIC (> 60 AS OF 8/2002).
C     THE OUTPUT WILL BE A TABLE OR ORDERED X1 AND X2 VALUES
C     AND CORRESPONDING STATISTICS FOR EACH X1 AND X2 VALUE
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/12
C     ORIGINAL VERSION--NOVEMBER  1989.
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --OCTOBER   1992.  ADD SUMS AND CHI-SQUARE
C     UPDATED         --AUGUST    2002.  EXPAND LIST OF SUPPORTED
C                                        STATISTICS
C     UPDATED         --MARCH     2003.  WEIGHTED MEAN, WEIGHTED SD,
C                                        WEIGHTED VARIANCE
C     UPDATED         --MARCH     2003.  35 "DIFFERENCE OF" STATISTICS
C     UPDATED         --APRIL     2003.  SN AND QN (AND DIFFERENCE OF)
C                                        REQUIRED ADDITION OF
C                                        ADDITIONAL SCRATCH ARRAYS
C     UPDATED         --MAY       2003.  WEIGHTED TRIMMED MEAN
C     UPDATED         --OCTOBER   2004.  KENDELLS TAU
C     UPDATED         --SEPTEMBER 2005.  RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASCT
      CHARACTER*40 ICTNAM
      CHARACTER*4 ICAPSW
      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
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHHR2
      CHARACTER*4 IHHR22
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
C
      CHARACTER*4 IXVAR
      CHARACTER*4 IYVAR
C
      CHARACTER*8 IYNAM
      CHARACTER*8 IXNAM
      CHARACTER*8 IX1NAM
      CHARACTER*8 IX2NAM
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
C
      DIMENSION XH1DIS(MAXOBV)
      DIMENSION XH2DIS(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMPZ(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
      DIMENSION ITEMP2(MAXOBV)
      DIMENSION ITEMP3(MAXOBV)
      DIMENSION ITEMP4(MAXOBV)
      DIMENSION ITEMP5(MAXOBV)
      DIMENSION ITEMP6(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
      EQUIVALENCE (GARBAG(IGARB1),XH1DIS(1))
      EQUIVALENCE (GARBAG(IGARB2),XH2DIS(1))
      EQUIVALENCE (GARBAG(IGARB3),TEMP(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMPZ(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB7),Z1(1))
      EQUIVALENCE (GARBAG(IGARB8),XTEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.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
      IERROR='NO'
C
      ISUBN1='DPCR'
      ISUBN2='TA  '
C
      IYNAM=' '
      IXNAM=' '
      IX1NAM=' '
      IX2NAM=' '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLH1=0
      ICOLH2=0
C
C               ******************************************
C               **  TREAT THE CROSS-TABULATION    CASE  **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICASCT
   52   FORMAT('ICASCT = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *******************************************************
C               **  STEP 1.5--                                       **
C               **  SEARCH FOR CROSS-TABULATE CHI-SQUARE             **
C               *******************************************************
C
      ICASCT='CSCT'
      IYVAR='ON'
      IXVAR='OFF'
C
      IF(NUMARG.LE.1)GOTO9000
      IF(ICOM.NE.'CROS')GOTO9000
      IF(IHARG(1).NE.'TABU')GOTO9000
C
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHIS')GOTO480
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'CHI '.AND.IHARG(2).EQ.'SQUA')GOTO482
C
CCCCC IF(IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO200
      IF(IHARG(1).EQ.'NUMB'.AND.IHARG2(1).EQ.'ER  ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'T   ')GOTO201
      IF(IHARG(1).EQ.'COUN'.AND.IHARG2(1).EQ.'TS  ')GOTO201
      IF(IHARG(1).EQ.'SIZE'.AND.IHARG2(1).EQ.'    ')GOTO201
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SAMP'.AND.IHARG(2).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SUBS'.AND.IHARG(2).EQ.'SIZE')GOTO202
C
      IF(IHARG(1).EQ.'SUM '.AND.IHARG2(1).EQ.'    ')GOTO211
      IF(IHARG(1).EQ.'PROD'.AND.IHARG2(1).EQ.'UCT ')GOTO212
      IF(IHARG(1).EQ.'INTE'.AND.IHARG2(1).EQ.'GRAL')GOTO213
C
      IF(IHARG(1).EQ.'MIDR'.AND.IHARG2(1).EQ.'ANGE')GOTO221
      IF(IHARG(1).EQ.'MEAN'.AND.IHARG2(1).EQ.'    ')GOTO222
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO413
      IF(IHARG(1).EQ.'AAD '.AND.IHARG2(1).EQ.'    ')GOTO414
C
      IF(IHARG(1).EQ.'AVER'.AND.IHARG2(1).EQ.'AGE ')GOTO222
      IF(IHARG(1).EQ.'MIDM'.AND.IHARG2(1).EQ.'EAN ')GOTO223
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  '.AND.
     1IHARG(2).EQ.'ABSO'.AND.
     1IHARG(3).EQ.'DEVI')GOTO415
      IF(IHARG(1).EQ.'MAD '.AND.IHARG2(1).EQ.'    ')GOTO416
C
      IF(IHARG(1).EQ.'MEDI'.AND.IHARG2(1).EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1(IHARG(3).NE.'STAN'.AND.IHARG(4).NE.'ERRO'))GOTO225
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WIND'.AND.IHARG(2).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'MEAN')GOTO226
C
      IF(IHARG(1).EQ.'R   '.AND.IHARG2(1).EQ.'    ')GOTO241
      IF(IHARG(1).EQ.'RANG'.AND.IHARG2(1).EQ.'E   ')GOTO241
      IF(IHARG(1).EQ.'MINI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MIN '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(IHARG(1).EQ.'MAXI'.AND.IHARG2(1).EQ.'MUM ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(IHARG(1).EQ.'MAX '.AND.IHARG2(1).EQ.'    ')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'BLOC'.AND.IHARG(3).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'ANCE')GOTO254
      IF(IHARG(1).EQ.'VARI'.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'VAR '.AND.IHARG(2).EQ.'MEAN')GOTO253
      IF(IHARG(1).EQ.'VAR '.AND.IHARG2(1).EQ.'    ')GOTO254
C
      IF(NUMARG.GE.5.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'THE '.AND.
     1IHARG(5).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'THE '.AND.IHARG(4).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SD  '.AND.IHARG(2).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI')GOTO264
      IF(IHARG(1).EQ.'SD  '.AND.IHARG2(1).EQ.'    ')GOTO265
      IF(IHARG(1).EQ.'S   '.AND.IHARG2(1).EQ.'    ')GOTO265
C
      IF(IHARG(1).EQ.'RS  '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RSD '.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'    ')GOTO271
      IF(IHARG(1).EQ.'RELS'.AND.IHARG2(1).EQ.'D   ')GOTO271
      IF(IHARG(1).EQ.'RV  '.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RVAR'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'    ')GOTO272
      IF(IHARG(1).EQ.'RELV'.AND.IHARG2(1).EQ.'AR  ')GOTO272
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'OF  '.AND.
     1IHARG(3).EQ.'VARI')GOTO273
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'COEF'.AND.IHARG(2).EQ.'VARI')GOTO274
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'FIRS'.AND.IHARG(2).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SECO'.AND.IHARG(2).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'THIR'.AND.IHARG(2).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'HING')GOTO304
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'THIR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'3RD '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO311
      IF(IHARG(1).EQ.'SKEW'.AND.IHARG2(1).EQ.'NESS')GOTO312
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'FOUR'.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'4TH '.AND.
     1IHARG(3).EQ.'CENT'.AND.IHARG(4).EQ.'MOME')GOTO313
      IF(IHARG(1).EQ.'KURT'.AND.IHARG2(1).EQ.'OSIS')GOTO314
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'COVA'.AND.
     1IHARG(2).EQ.'PLOT')GOTO321
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AUTO'.AND.IHARG2(1).EQ.'CORR'.AND.
     1IHARG(2).EQ.'PLOT')GOTO322
C
      IF(IHARG(1).EQ.'COVA'.AND.IHARG2(1).EQ.'RIAN')GOTO331
      IF(IHARG(1).EQ.'CORR'.AND.IHARG2(1).EQ.'ELAT')GOTO332
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COVA')GOTO333
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'CORR')GOTO334
      IF(IHARG(1).EQ.'COMO'.AND.IHARG2(1).EQ.'VEME')GOTO335
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'RANK'.AND.IHARG(2).EQ.'COMO')GOTO336
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'KEND'.AND.IHARG(2).EQ.'TAU ')GOTO337
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'DECI')GOTO1111
      GOTO1119
 1111 CONTINUE
      IF(IHARG(1).EQ.'FIRS')GOTO341
      IF(IHARG(1).EQ.'SECO')GOTO342
      IF(IHARG(1).EQ.'THIR')GOTO343
      IF(IHARG(1).EQ.'FOUR')GOTO344
      IF(IHARG(1).EQ.'FIFT')GOTO345
      IF(IHARG(1).EQ.'SIXT')GOTO346
      IF(IHARG(1).EQ.'SEVE')GOTO347
      IF(IHARG(1).EQ.'EIGH')GOTO348
      IF(IHARG(1).EQ.'NINT')GOTO349
 1119 CONTINUE
C
      IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).NE.'BEND'.AND.
     1  IHARG(2).NE.'DEFE')GOTO350
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMP')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SIN'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SINE'.AND.IHARG(2).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'INTE')GOTO363
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'SLOP')GOTO364
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'RESS')GOTO365
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LINE'.AND.IHARG(2).EQ.'CORR')GOTO366
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'SN'.AND.IHARG(2).EQ.'SCAL')GOTO493
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'QN'.AND.IHARG(2).EQ.'SCAL')GOTO495
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(2).EQ.'SN')GOTO371
      IF(IHARG(2).EQ.'S/N')GOTO371
      IF(IHARG(2).EQ.'SN0')GOTO371
      IF(IHARG(2).EQ.'S/N0')GOTO371
      IF(IHARG(2).EQ.'SNT')GOTO371
      IF(IHARG(2).EQ.'S/NT')GOTO371
      IF(IHARG(2).EQ.'SN+')GOTO372
      IF(IHARG(2).EQ.'S/N+')GOTO372
      IF(IHARG(2).EQ.'SNL')GOTO372
      IF(IHARG(2).EQ.'SN-')GOTO373
      IF(IHARG(2).EQ.'S/N-')GOTO373
      IF(IHARG(2).EQ.'SNS')GOTO373
      IF(IHARG(2).EQ.'SN00')GOTO374
      IF(IHARG(2).EQ.'SNT2')GOTO374
      IF(IHARG(2).EQ.'S/N2')GOTO374
      IF(IHARG(2).EQ.'SN2')GOTO374
  139 CONTINUE
C
      IF(IHARG(1).EQ.'SN')GOTO381
      IF(IHARG(1).EQ.'S/N')GOTO381
      IF(IHARG(1).EQ.'SN0')GOTO381
      IF(IHARG(1).EQ.'S/N0')GOTO381
      IF(IHARG(1).EQ.'SNT')GOTO381
      IF(IHARG(1).EQ.'S/NT')GOTO381
      IF(IHARG(1).EQ.'SN+')GOTO382
      IF(IHARG(1).EQ.'S/N+')GOTO382
      IF(IHARG(1).EQ.'SNL ')GOTO382
      IF(IHARG(1).EQ.'SN-')GOTO383
      IF(IHARG(1).EQ.'S/N-')GOTO383
      IF(IHARG(1).EQ.'SNS')GOTO383
      IF(IHARG(1).EQ.'SN00')GOTO384
      IF(IHARG(1).EQ.'SNT2')GOTO384
      IF(IHARG(1).EQ.'S/N2')GOTO384
      IF(IHARG(1).EQ.'SN2')GOTO384
C
      IF(IHARG(1).EQ.'CP')GOTO401
      IF(IHARG(1).EQ.'CPK')GOTO402
      IF(IHARG(1).EQ.'CNPK')GOTO398
      IF(IHARG(1).EQ.'CPM')GOTO400
      IF(IHARG(1).EQ.'CC')GOTO399
      IF(IHARG(1).EQ.'CPL')GOTO396
      IF(IHARG(1).EQ.'CPU')GOTO397
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'DEFE')GOTO403
         IF(IHARG(1).EQ.'EXPE'.AND.IHARG(2).EQ.'LOSS')GOTO404
      ENDIF
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'NORM'.AND.IHARG(2).EQ.'PPCC')GOTO411
      ENDIF
C
      IF(IHARG(1).EQ.'EXTR')GOTO412
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'GEOM'.AND.IHARG2(1).EQ.'ETRI'.AND.
     1IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HARM'.AND.IHARG(2).EQ.'MEAN')GOTO446
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'INTE'.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'IQ  '.AND.IHARG(2).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'LOCA')GOTO457
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'SCAL')GOTO458
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'VARI')GOTO459
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'SD')GOTO460
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'DEVI')
     1GOTO461
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'COVA')GOTO462
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WINS'.AND.IHARG(2).EQ.'CORR')GOTO463
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDV')GOTO464
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.
     1IHARG(2).EQ.'MIDC'.AND.IHARG2(2).EQ.'ORRE')GOTO471
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'BIWE'.AND.IHARG(2).EQ.'MIDC')GOTO465
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'MIDV')
     1GOTO466
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'HODG'.AND.IHARG(2).EQ.'LEHM')GOTO467
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'QUAN'.AND.IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')
     1GOTO468
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'QUAN')GOTO469
C
      IF(NUMARG.GE.4.AND.
     1IHARG(1).EQ.'TRIM'.AND.IHARG(2).EQ.'MEAN'.AND.
     1IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'ERRO')
     1GOTO470
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'PERC'.AND.IHARG(2).EQ.'BEND'.AND.IHARG(3).EQ.'CORR')
     1GOTO472
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'MEAN')GOTO486
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'SD')GOTO490
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'DEVI')GOTO491
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'WEIG'.AND.IHARG(2).EQ.'TRIM'.AND.
     1IHARG(3).EQ.'MEAN')GOTO492
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIFF'.AND.IHARG(2).EQ.'OF')THEN
        IF(IHARG(3).EQ.'AVER'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO623
        IF(IHARG(3).EQ.'AAD')GOTO523
        IF(IHARG(3).EQ.'MEAN' .OR. IHARG(3).EQ.'AVER')GOTO501
        IF(IHARG(3).EQ.'MIDM')GOTO502
        IF(IHARG(3).EQ.'MEDI'.AND.IHARG(4).EQ.'ABSO'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO624
        IF(IHARG(3).EQ.'MAD')GOTO524
        IF(IHARG(3).EQ.'MEDI')GOTO503
        IF(IHARG(3).EQ.'TRIM'.AND.IHARG(4).EQ.'MEAN')GOTO504
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'MEAN')GOTO505
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'MEAN')GOTO506
        IF(IHARG(3).EQ.'HARM'.AND.IHARG(4).EQ.'MEAN')GOTO507
        IF(IHARG(3).EQ.'HODG'.AND.IHARG(4).EQ.'LEHM')GOTO508
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'LOCA')GOTO509
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO738
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO638
        IF(IHARG(3).EQ.'SD'.AND.IHARG(4).EQ.'MEAN')GOTO538
        IF(IHARG(3).EQ.'SD')GOTO520
        IF(IHARG(3).EQ.'STAN'.AND.IHARG(4).EQ.'DEVI')GOTO521
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'THE'.AND.IHARG(6).EQ.'MEAN')GOTO740
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'MEAN')GOTO640
        IF(IHARG(3).EQ.'VARI'.AND.IHARG(4).EQ.'MEAN')GOTO540
        IF(IHARG(3).EQ.'VARI')GOTO522
        IF(IHARG(3).EQ.'INTE'.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'IQ  '.AND.IHARG(4).EQ.'RANG')GOTO525
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO626
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'SD')GOTO526
        IF(IHARG(3).EQ.'WINS'.AND.IHARG(4).EQ.'VARI')GOTO527
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'MIDV')GOTO528
        IF(IHARG(3).EQ.'BIWE'.AND.IHARG(4).EQ.'SCAL')GOTO529
        IF(IHARG(3).EQ.'PERC'.AND.IHARG(4).EQ.'BEND'.AND.
     1     IHARG(5).EQ.'MIDV')GOTO530
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'STAN'.AND.
     1     IHARG(5).EQ.'DEVI')GOTO631
        IF(IHARG(3).EQ.'GEOM'.AND.IHARG(4).EQ.'SD')GOTO531
        IF(IHARG(3).EQ.'RANG')GOTO532
        IF(IHARG(3).EQ.'MIDR')GOTO533
        IF(IHARG(3).EQ.'QUAN')GOTO534
        IF(IHARG(3).EQ.'SKEW')GOTO535
        IF(IHARG(3).EQ.'KURT')GOTO536
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'SD')GOTO537
        IF(IHARG(3).EQ.'RELA'.AND.IHARG(4).EQ.'VARI')GOTO539
        IF(IHARG(3).EQ.'MINI')GOTO541
        IF(IHARG(3).EQ.'MAXI')GOTO542
        IF(IHARG(3).EQ.'EXTR')GOTO543
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'OF'.AND.
     1     IHARG(5).EQ.'VARI')GOTO554
        IF(IHARG(3).EQ.'COEF'.AND.IHARG(4).EQ.'VARI')GOTO544
        IF(IHARG(3).EQ.'SN'.AND.IHARG(4).EQ.'SCAL')GOTO645
        IF(IHARG(3).EQ.'SN')GOTO545
        IF(IHARG(3).EQ.'QN'.AND.IHARG(4).EQ.'SCAL')GOTO646
        IF(IHARG(3).EQ.'QN')GOTO546
        IF(IHARG(3).EQ.'SUM')GOTO551
        IF(IHARG(3).EQ.'SUMS')GOTO551
CCCCC   SIZE MAKES NO SENSE IN THIS CONTEXT (GROUP SIZE ARE EQUAL
CCCCC   FOR BOTH VARIABLES, SO ALWAYS ZERO)
CCCCC   IF(IHARG(3).EQ.'SIZE')GOTO552
CCCCC   IF(IHARG(3).EQ.'NUMB')GOTO552
CCCCC   IF(IHARG(3).EQ.'COUN')GOTO552
      ENDIF
C
      IF(IHARG(1).EQ.'RATI')GOTO553
C
CCCCC IF NO MATCH, ASSUME COUNTS (I.E., CROSS TABULATE X1 X2)
CCCCC IFOUND='NO'
CCCCC GOTO9000
      GOTO200
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASCT.  **
C               **********************
C
  200 CONTINUE
      ICASCT='COUN'
      ICTNAM='COUNT'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO110
C
  201 CONTINUE
      ICASCT='NUMB'
      ICTNAM='COUNT'
      IYVAR='OFF'
      GOTO111
C
  202 CONTINUE
      ICASCT='NUMB'
      ICTNAM='COUNT'
      IYVAR='OFF'
      GOTO112
C
  211 CONTINUE
      ICASCT='SUM'
      ICTNAM='SUM'
      GOTO111
C
  212 CONTINUE
      ICASCT='PROD'
      ICTNAM='PRODUCT'
      GOTO111
C
  213 CONTINUE
      ICASCT='INTE'
      ICTNAM='INTEGRAL'
      GOTO111
C
  221 CONTINUE
      ICASCT='MIDR'
      ICTNAM='MID-RANGE'
      GOTO111
C
  222 CONTINUE
      ICASCT='MEAN'
      ICTNAM='MEAN'
      GOTO111
C
  223 CONTINUE
      ICASCT='MIDM'
      ICTNAM='MID-MEAN'
      GOTO111
C
  224 CONTINUE
      ICASCT='MEDI'
      ICTNAM='MEDIAN'
      GOTO111
C
  225 CONTINUE
      ICASCT='TRIM'
      ICTNAM='TRIMMED MEAN'
      GOTO112
C
  226 CONTINUE
      ICASCT='WINM'
      ICTNAM='WINSORIZED MEAN'
      GOTO112
C
  241 CONTINUE
      ICASCT='RANG'
      ICTNAM='RANGE'
      GOTO111
C
  242 CONTINUE
      ICASCT='MINI'
      ICTNAM='MINIMUM'
      GOTO111
C
  243 CONTINUE
      ICASCT='MAXI'
      ICTNAM='MAXIMUM'
      GOTO111
C
  251 CONTINUE
      ICASCT='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO114
C
  252 CONTINUE
      ICASCT='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO113
C
  253 CONTINUE
      ICASCT='VAME'
      ICTNAM='VARIANCE OF THE MEAN'
      GOTO112
C
  254 CONTINUE
      ICASCT='VARI'
      ICTNAM='VARIANCE'
      GOTO111
C
  261 CONTINUE
      ICASCT='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO115
C
  262 CONTINUE
      ICASCT='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO114
C
  263 CONTINUE
      ICASCT='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO113
C
  264 CONTINUE
      ICASCT='SD'
      ICTNAM='STANDARD DEVIATION'
      GOTO112
C
  265 CONTINUE
      ICASCT='SD'
      ICTNAM='STANDARD DEVIATION'
      GOTO111
C
  266 CONTINUE
      ICASCT='SDME'
      ICTNAM='SD OF THE MEAN'
      GOTO112
C
  271 CONTINUE
      ICASCT='RESD'
      ICTNAM='RELATIVE SD'
      GOTO111
C
  272 CONTINUE
      ICASCT='REVA'
      ICTNAM='RELATIVE VARIANCE'
      GOTO111
C
  273 CONTINUE
      ICASCT='CVAR'
      ICTNAM='COEFFICIENT OF VARIATION'
      GOTO113
C
  274 CONTINUE
      ICASCT='CVAR'
      ICTNAM='COEFFICIENT OF VARIATION'
      GOTO112
C
  276 CONTINUE
      ICASCT='RESD'
      ICTNAM='RELATIVE SD'
      GOTO112
C
  277 CONTINUE
      ICASCT='RESD'
      ICTNAM='RELATIVE SD'
      GOTO113
C
  278 CONTINUE
      ICASCT='REVA'
      ICTNAM='RELATIVE VARIANCE'
      GOTO112
C
  301 CONTINUE
      ICASCT='LOWQ'
      ICTNAM='LOWER QUARTILE'
      GOTO112
C
  302 CONTINUE
      ICASCT='MIDQ'
      ICTNAM='MID-QUANTILE'
      GOTO112
C
  303 CONTINUE
      ICASCT='UPPQ'
      ICTNAM='UPPER QUARTILE'
      GOTO112
C
  304 CONTINUE
      ICASCT='LOWH'
      ICTNAM='LOWER HINGE'
      GOTO112
C
  305 CONTINUE
      ICASCT='UPPH'
      ICTNAM='UPPER HINGE'
      GOTO112
C
  311 CONTINUE
      ICASCT='SKEW'
      ICTNAM='SKEWNESS'
      GOTO114
C
  312 CONTINUE
      ICASCT='SKEW'
      ICTNAM='SKEWNESS'
      GOTO111
C
  313 CONTINUE
      ICASCT='KURT'
      ICTNAM='KURTOSIS'
      GOTO114
C
  314 CONTINUE
      ICASCT='KURT'
      ICTNAM='KURTOSIS'
      GOTO111
C
  321 CONTINUE
      ICASCT='AUCV'
      ICTNAM='AUTOCOVARIANCE'
      GOTO111
C
  322 CONTINUE
      ICASCT='AUCR'
      ICTNAM='AUTOCORRELATION'
      GOTO111
C
  331 CONTINUE
      ICASCT='COVA'
      IXVAR='ON'
      ICTNAM='COVARIANCE'
      GOTO111
C
  332 CONTINUE
      ICASCT='CORR'
      IXVAR='ON'
      ICTNAM='CORRELATION'
      GOTO111
C
  333 CONTINUE
      ICASCT='RACV'
      IXVAR='ON'
      ICTNAM='RANK COVARIANCE'
      GOTO112
C
  334 CONTINUE
      ICASCT='RACR'
      IXVAR='ON'
      ICTNAM='RANK CORRELATION'
      GOTO112
C
  335 CONTINUE
      ICASCT='COMO'
      IXVAR='ON'
      ICTNAM='COMOVEMENT'
      GOTO111
C
  336 CONTINUE
      ICASCT='RACO'
      IXVAR='ON'
      ICTNAM='RANK COMOVEMENT'
      GOTO112
C
  337 CONTINUE
      ICASCT='KTAU'
      IXVAR='ON'
      ICTNAM='KENDELLS TAU'
      GOTO112
C
  341 CONTINUE
      ICASCT='1DEC'
      ICTNAM='FIRST DECILE'
      GOTO112
C
  342 CONTINUE
      ICASCT='2DEC'
      ICTNAM='SECOND DECILE'
      GOTO112
C
  343 CONTINUE
      ICASCT='3DEC'
      ICTNAM='THIRD DECILE'
      GOTO112
C
  344 CONTINUE
      ICASCT='4DEC'
      ICTNAM='FOURTH DECILE'
      GOTO112
C
  345 CONTINUE
      ICASCT='5DEC'
      ICTNAM='FIFTH DECILE'
      GOTO112
C
  346 CONTINUE
      ICASCT='6DEC'
      ICTNAM='SIXTH DECILE'
      GOTO112
C
  347 CONTINUE
      ICASCT='7DEC'
      ICTNAM='SEVENTH DECILE'
      GOTO112
C
  348 CONTINUE
      ICASCT='8DEC'
      ICTNAM='EIGHTH DECILE'
      GOTO112
C
  349 CONTINUE
      ICASCT='9DEC'
      ICTNAM='NINTH DECILE'
      GOTO112
C
  350 CONTINUE
      ICASCT='PERC'
      ICTNAM='PERCENTILE'
      GOTO111
C
  361 CONTINUE
      ICASCT='SIFR'
      ICTNAM='SINE FREQUENCY'
      GOTO112
C
  362 CONTINUE
      ICASCT='SIAM'
      ICTNAM='SINE AMPLITUDE'
      GOTO112
C
  363 CONTINUE
      ICASCT='LIIN'
      IXVAR='ON'
      ICTNAM='LINEAR INTERCEPT'
      GOTO112
C
  364 CONTINUE
      ICASCT='LISL'
      IXVAR='ON'
      ICTNAM='LINEAR SLOPE'
      GOTO112
C
  365 CONTINUE
      ICASCT='LIRE'
      IXVAR='ON'
      ICTNAM='LINEAR RESSD'
      GOTO112
C
  366 CONTINUE
      ICASCT='LICO'
      IXVAR='ON'
      ICTNAM='LINEAR CORRELATION'
      GOTO112
C
  371 CONTINUE
      ICASCT='SN0'
      ICTNAM='SN0'
      GOTO112
C
  372 CONTINUE
      ICASCT='SN+'
      ICTNAM='SN+'
      GOTO112
C
  373 CONTINUE
      ICASCT='SN-'
      ICTNAM='SN-'
      GOTO112
C
  374 CONTINUE
      ICASCT='SN00'
      ICTNAM='SN00'
      GOTO112
C
  381 CONTINUE
      ICASCT='SN0'
      ICTNAM='SN0'
      GOTO111
C
  382 CONTINUE
      ICASCT='SN+'
      ICTNAM='SN+'
      GOTO111
C
  383 CONTINUE
      ICASCT='SN-'
      ICTNAM='SN-'
      GOTO111
C
  384 CONTINUE
      ICASCT='SN00'
      ICTNAM='SN00'
      GOTO111
C
  396 CONTINUE
      ICASCT='CPL'
      ICTNAM='CPL'
      GOTO111
C
  397 CONTINUE
      ICASCT='CPU'
      ICTNAM='CPU'
      GOTO111
C
  398 CONTINUE
      ICASCT='CNPK'
      ICTNAM='CNPK'
      GOTO111
C
  399 CONTINUE
      ICASCT='CC'
      ICTNAM='CC'
      GOTO111
C
  400 CONTINUE
      ICASCT='CPM'
      ICTNAM='CPM'
      GOTO111
C
  401 CONTINUE
      ICASCT='CP'
      ICTNAM='CP'
      GOTO111
C
  402 CONTINUE
      ICASCT='CPK'
      ICTNAM='CPK'
      GOTO111
C
  403 CONTINUE
      ICASCT='PEDE'
      ICTNAM='PERCENT DEFECTIVE'
      GOTO112
C
  404 CONTINUE
      ICASCT='EXLO'
      ICTNAM='EXPECTED LOSS'
      GOTO112
C
  411 CONTINUE
      ICASCT='NOPP'
      ICTNAM='NORMAL PPCC'
      GOTO112
C
  412 CONTINUE
      ICASCT='EXTR'
      ICTNAM='EXTREME'
      GOTO111
C
  413 CONTINUE
      ICASCT='AAD '
      ICTNAM='AVERAGE ABSOLUTE DEVIATION'
      GOTO113
C
  414 CONTINUE
      ICASCT='AAD '
      ICTNAM='AVERAGE ABSOLUTE DEVIATION'
      GOTO111
C
  415 CONTINUE
      ICASCT='MAD '
      ICTNAM='MEDIAN ABSOLUTE DEVIATION'
      GOTO113
C
  416 CONTINUE
      ICASCT='MAD '
      ICTNAM='MEDIAN ABSOLUTE DEVIATION'
      GOTO111
C
  426 CONTINUE
      ICASCT='GEME'
      ICTNAM='GEOMETRIC MEAN'
      GOTO112
C
  436 CONTINUE
      ICASCT='GESD'
      ICTNAM='GEOMETRIC STANDARD DEVIATION'
      GOTO113
C
  446 CONTINUE
      ICASCT='HAME'
      ICTNAM='HARMONIC MEAN'
      GOTO112
C
  456 CONTINUE
      ICASCT='IQRA'
      ICTNAM='INTERQUARTILE RANGE'
      GOTO112
C
  457 CONTINUE
      ICASCT='BILO'
      ICTNAM='BIWEIGHT LOCATION'
      GOTO112
C
  458 CONTINUE
      ICASCT='BISC'
      ICTNAM='BIWEIGHT SCALE'
      GOTO112
C
  459 CONTINUE
      ICASCT='WIVA'
      ICTNAM='WINSORIZED VARIANCE'
      GOTO112
C
  460 CONTINUE
      ICASCT='WISD'
      ICTNAM='WINSORIZED SD'
      GOTO112
C
  461 CONTINUE
      ICASCT='WISD'
      ICTNAM='WINSORIZED SD'
      GOTO113
C
  462 CONTINUE
      ICASCT='WICV'
      IXVAR='ON'
      ICTNAM='WINSORIZED COVARIANCE'
      GOTO112
C
  463 CONTINUE
      ICASCT='WICR'
      IXVAR='ON'
      ICTNAM='WINSORIZED CORRELATION'
      GOTO112
C
  464 CONTINUE
      ICASCT='BIMV'
      ICTNAM='BIWEIGHT MIDVARIANCE'
      GOTO112
C
  465 CONTINUE
      ICASCT='BIMC'
      IXVAR='ON'
      ICTNAM='BIWEIGHT MIDCOVARIANCE'
      GOTO112
C
  466 CONTINUE
      ICASCT='PBMV'
      ICTNAM='PERCENTAGE BEND MIDVARIANCE'
      GOTO113
C
  467 CONTINUE
      ICASCT='HLEH'
      ICTNAM='HODGES-LEHMAN'
      GOTO112
C
  468 CONTINUE
      ICASCT='QUSE'
      ICTNAM='QUANTILE STANDARD ERROR'
      GOTO113
C
  469 CONTINUE
      ICASCT='QUAN'
      ICTNAM='QUANTILE'
      GOTO111
C
  470 CONTINUE
      ICASCT='TMSE'
      ICTNAM='TRIMMED MEAN STANDARD ERROR'
      GOTO114
C
  471 CONTINUE
      ICASCT='BICR'
      IXVAR='ON'
      ICTNAM='BIWEIGHT CORRELATION'
      GOTO112
C
  472 CONTINUE
      ICASCT='PBCR'
      ICTNAM='PERCENTAGE BEND CORRELATION'
      IXVAR='ON'
      GOTO113
C
  480 CONTINUE
      ICASCT='CSCT'
      ICTNAM='CHI-SQUARE TEST OF INDEPENDENCE'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO111
C
  482 CONTINUE
      ICASCT='CSCT'
      ICTNAM='CHI-SQUARE TEST OF INDEPENDENCE'
      IYVAR='OFF'
      IXVAR='OFF'
      GOTO112
C
  486 CONTINUE
      ICASCT='WEME'
      ICTNAM='WEIGHTED MEAN'
      IXVAR='ON'
      GOTO112
C
  488 CONTINUE
      ICASCT='WEVA'
      ICTNAM='WEIGHTED VARIANCE'
      IXVAR='ON'
      GOTO112
C
  490 CONTINUE
      ICASCT='WESD'
      ICTNAM='WEIGHTED STANDARD DEVIATION'
      IXVAR='ON'
      GOTO112
C
  491 CONTINUE
      ICASCT='WESD'
      ICTNAM='WEIGHTED STANDARD DEVIATION'
      IXVAR='ON'
      GOTO113
C
  492 CONTINUE
      ICASCT='WETM'
      ICTNAM='WEIGHTED TRIMMED MEAN'
      IXVAR='ON'
      GOTO113
C
  493 CONTINUE
      ICASCT='SNSC'
      ICTNAM='SN'
      GOTO112
C
  495 CONTINUE
      ICASCT='QNSC'
      ICTNAM='QN'
      GOTO112
C
  501 CONTINUE
      ICASCT='DMEA'
      ICTNAM='DIFFERENCE OF MEANS'
      IXVAR='ON'
      GOTO113
C
  502 CONTINUE
      ICASCT='DMDM'
      ICTNAM='DIFFERENCE OF MIDMEANS'
      IXVAR='ON'
      GOTO113
C
  503 CONTINUE
      ICASCT='DMED'
      ICTNAM='DIFFERENCE OF MEDIAN'
      IXVAR='ON'
      GOTO113
C
  504 CONTINUE
      ICASCT='DTRM'
      ICTNAM='DIFFERENCE OF TRIMMED MEANS'
      IXVAR='ON'
      GOTO114
C
  505 CONTINUE
      ICASCT='DWNM'
      ICTNAM='DIFFERENCE OF WINSORIZED MEANS'
      IXVAR='ON'
      GOTO114
C
  506 CONTINUE
      ICASCT='DGEO'
      ICTNAM='DIFFERENCE OF GEOMETRIC MEANS'
      IXVAR='ON'
      GOTO114
C
  507 CONTINUE
      ICASCT='DHAR'
      ICTNAM='DIFFERENCE OF HARMONIC MEANS'
      IXVAR='ON'
      GOTO114
C
  508 CONTINUE
      ICASCT='DHDL'
      ICTNAM='DIFFERENCE OF HODGES-LEHMANN'
      IXVAR='ON'
      GOTO114
C
  509 CONTINUE
      ICASCT='DBIW'
      ICTNAM='DIFFERENCE OF BIWEIGHT LOCATION'
      IXVAR='ON'
      GOTO114
C
  520 CONTINUE
      ICASCT='DSD '
      ICTNAM='DIFFERENCE OF STANDARD DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  521 CONTINUE
      ICASCT='DSD '
      ICTNAM='DIFFERENCE OF STANDARD DEVIATIONS'
      IXVAR='ON'
      GOTO114
C
  522 CONTINUE
      ICASCT='DVAR'
      ICTNAM='DIFFERENCE OF VARIANCES'
      IXVAR='ON'
      GOTO113
C
  623 CONTINUE
      ICASCT='DAAD'
      ICTNAM='DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO115
C
  523 CONTINUE
      ICASCT='DAAD'
      ICTNAM='DIFFERENCE OF AVERAGE ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  624 CONTINUE
      ICASCT='MAAD'
      ICTNAM='DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO115
C
  524 CONTINUE
      ICASCT='DMAD'
      ICTNAM='DIFFERENCE OF MEDIAN ABSOLUTE DEVIATIONS'
      IXVAR='ON'
      GOTO113
C
  525 CONTINUE
      ICASCT='DIQR'
      ICTNAM='DIFFERENCE OF INTERQUARTILE RANGES'
      IXVAR='ON'
      GOTO114
C
  626 CONTINUE
      ICASCT='DWSD'
      ICTNAM='DIFFERENCE OF WINSORIZED SD'
      IXVAR='ON'
      GOTO115
C
  526 CONTINUE
      ICASCT='DWSD'
      ICTNAM='DIFFERENCE OF WINSORIZED SD'
      IXVAR='ON'
      GOTO114
C
  527 CONTINUE
      ICASCT='DWVA'
      ICTNAM='DIFFERENCE OF WINSORIZED VARIANCES'
      IXVAR='ON'
      GOTO114
C
  528 CONTINUE
      ICASCT='DBIM'
      ICTNAM='DIFFERENCE OF BIWEIGHT MIDVARIANCES'
      IXVAR='ON'
      GOTO114
C
  529 CONTINUE
      ICASCT='DBIS'
      ICTNAM='DIFFERENCE OF BIWEIGHT SCALE'
      IXVAR='ON'
      GOTO114
C
  530 CONTINUE
      ICASCT='DPBN'
      ICTNAM='DIFFERENCE OF PERCENTAGE BEND MIDVARIANCE'
      IXVAR='ON'
      GOTO115
C
  631 CONTINUE
      ICASCT='DGSD'
      ICTNAM='DIFFERENCE OF GEOMETRIC SD'
      IXVAR='ON'
      GOTO115
C
  531 CONTINUE
      ICASCT='DGSD'
      ICTNAM='DIFFERENCE OF GEOMETRIC SD'
      IXVAR='ON'
      GOTO114
C
  532 CONTINUE
      ICASCT='DRAN'
      ICTNAM='DIFFERENCE OF RANGES'
      IXVAR='ON'
      GOTO113
C
  533 CONTINUE
      ICASCT='DMDR'
      ICTNAM='DIFFERENCE OF MIDRANGES'
      IXVAR='ON'
      GOTO113
C
  534 CONTINUE
      ICASCT='DQUA'
      ICTNAM='DIFFERENCE OF QUANTILES'
      IXVAR='ON'
      GOTO113
C
  535 CONTINUE
      ICASCT='DSKE'
      ICTNAM='DIFFERENCE OF SKEWNESS'
      IXVAR='ON'
      GOTO113
C
  536 CONTINUE
      ICASCT='DKUR'
      ICTNAM='DIFFERENCE OF KURTOSIS'
      IXVAR='ON'
      GOTO113
C
  537 CONTINUE
      ICASCT='DRSD'
      ICTNAM='DIFFERENCE OF RELATIVE SD'
      IXVAR='ON'
      GOTO114
C
  738 CONTINUE
      ICASCT='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO116
C
  638 CONTINUE
      ICASCT='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO115
C
  538 CONTINUE
      ICASCT='DSDM'
      ICTNAM='DIFFERENCE OF SD OF THE MEAN'
      IXVAR='ON'
      GOTO114
C
  539 CONTINUE
      ICASCT='DRVA'
      ICTNAM='DIFFERENCE OF RELATIVE VARIANCES'
      IXVAR='ON'
      GOTO114
C
  740 CONTINUE
      ICASCT='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO116
C
  640 CONTINUE
      ICASCT='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO115
C
  540 CONTINUE
      ICASCT='DVAM'
      ICTNAM='DIFFERENCE OF VARIANCE OF THE MEANS'
      IXVAR='ON'
      GOTO114
C
  541 CONTINUE
      ICASCT='DMIN'
      ICTNAM='DIFFERENCE OF MINIMUMS'
      IXVAR='ON'
      GOTO113
C
  542 CONTINUE
      ICASCT='DMAX'
      ICTNAM='DIFFERENCE OF MAXIMUMS'
      IXVAR='ON'
      GOTO113
C
  543 CONTINUE
      ICASCT='DEXT'
      ICTNAM='DIFFERENCE OF EXTREMES'
      IXVAR='ON'
      GOTO113
C
  554 CONTINUE
      ICASCT='DCVA'
      ICTNAM='DIFFERENCE OF COEFFICIENT OF VARIATION'
      IXVAR='ON'
      GOTO115
C
  544 CONTINUE
      ICASCT='DCVA'
      ICTNAM='DIFFERENCE OF COEFFICIENT OF VARIATION'
      IXVAR='ON'
      GOTO114
C
  645 CONTINUE
      ICASCT='DSN'
      ICTNAM='DIFFERENCE OF SN'
      IXVAR='ON'
      GOTO114
C
  545 CONTINUE
      ICASCT='DSN'
      ICTNAM='DIFFERENCE OF SN'
      IXVAR='ON'
      GOTO113
C
  646 CONTINUE
      ICASCT='DQN'
      ICTNAM='DIFFERENCE OF QN'
      IXVAR='ON'
      GOTO114
C
  546 CONTINUE
      ICASCT='DQN'
      ICTNAM='DIFFERENCE OF QN'
      IXVAR='ON'
      GOTO113
C
  551 CONTINUE
      ICASCT='DSUM'
      ICTNAM='DIFFERENCE OF SUM'
      IXVAR='ON'
      GOTO113
C
  552 CONTINUE
      ICASCT='DCOU'
      ICTNAM='DIFFERENCE OF COUNTS'
      IXVAR='ON'
      GOTO113
C
  553 CONTINUE
      ICASCT='RATI'
      ICTNAM='RATIO'
      IXVAR='ON'
      GOTO111
C
  110 CONTINUE
      ILASTC=0
      GOTO180
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
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  115 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  116 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS. **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      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)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,1211)IHLEFT,ICOLL,NLEFT
 1211   FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************************
C               **  STEP 3--                                          **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS       **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS 1 OR LARGER. **
C               ********************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPCRTA--THE INPUT NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1313)ICTNAM
 1313   FORMAT('      (FOR WHICH A ',A30,' CROSS-TABULATION WAS TO')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1315)MINN2
 1315   FORMAT('      HAVE BEEN FORMED MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1316)
 1316   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1317)
 1317   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1318)(IANS(I),I=1,MIN(80,IWIDTH))
 1318     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1480
      DO1400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1420
 1400 CONTINUE
      GOTO1490
 1410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1490
 1420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1490
C
 1480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('***** INTERNAL ERROR IN DPCRTA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('      AT BRANCH POINT 1481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1483)
 1483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1484)
 1484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1485)NUMARG
 1485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1486)
 1486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,1487)(IANS(I),I=1,IWIDTH)
 1487   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,1491)NUMARG,ILOCQ,ICASEQ
 1491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
C               ******************************************************
C               **  STEP 25--                                       **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST VARIABLE ARE TO BE GROUPED                **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;         **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE        **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,           **
C               **  STANDARD DEVIATIONS, RANGES, AND                **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.             **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,
C               **  ETC.  IN THE RESULTING STATISTIC PLOT.           **
C               **  THE VALUES IN THE SECOND VARIABLE               **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                   **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.          **
C               **  IF WE HAVE THE 2-VARIABLE CASE,                 **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='25'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(IYVAR.EQ.'OFF'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=2
        ITAG1=1
        ITAG2=2
        IY=0
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'OFF')THEN
        NUMEXP=3
        ITAG1=2
        ITAG2=3
        IY=1
        IX=0
      ELSEIF(IYVAR.EQ.'ON'.AND.IXVAR.EQ.'ON')THEN
        NUMEXP=4
        ITAG1=3
        ITAG2=4
        IY=1
        IX=2
      ELSE
        NUMEXP=2
        ITAG1=1
        ITAG2=2
        IY=0
        IX=0
      ENDIF
C
 2510 CONTINUE
      IF(NUMEXP.NE.NUMV2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2511)
 2511   FORMAT('***** ERROR IN DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2512)
 2512   FORMAT('      FOR THIS CROSS TABULATE ..., ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2518)NUMEXP
 2518   FORMAT('      THE EXPECTED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2520)
 2520   FORMAT('      SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2521)NUMV2
 2521   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2523)
 2523   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2524)(IANS(I),I=1,MIN(80,IWIDTH))
 2524     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NPTS=NLEFT
      IF(IYVAR.EQ.'ON')THEN
        IHLEFT=IHARG(IY)
        IHLEF2=IHARG2(IY)
        IYNAM(1:4)=IHLEFT
        IYNAM(5:8)=IHLEF2
        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)
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')THEN
          WRITE(ICOUT,2541)IHLEFT,ICOLL,NLEFT
 2541     FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(IXVAR.EQ.'ON')THEN
        IHX=IHARG(IX)
        IHX2=IHARG2(IX)
        IXNAM(1:4)=IHX
        IXNAM(5:8)=IHX2
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHX,IHX2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOLX=IVALUE(ILOCV)
        NX=IN(ILOCV)
        IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')THEN
          WRITE(ICOUT,2546)IHX,ICOLX,NX
 2546     FORMAT('IHX,ICOLX,NX   = ',A4,I8,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IHHOR=IHARG(ITAG1)
      IHHOR2=IHARG2(ITAG1)
      IX1NAM(1:4)=IHHOR
      IX1NAM(5:8)=IHHOR2
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,2551)IHHOR,ICOLH,NHOR
 2551   FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IHHR2=IHARG(ITAG2)
      IHHR22=IHARG2(ITAG2)
      IX2NAM(1:4)=IHHR2
      IX2NAM(5:8)=IHHR22
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHR2,IHHR22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH2=IVALUE(ILOCV)
      NHOR2=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,2561)IHHR2,ICOLH2,NHOR2
 2561   FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IXVAR.EQ.'ON'.AND.NX.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2571)
 2571   FORMAT('***** ERROR IN DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2572)
 2572   FORMAT('      FOR A CROSS TABULATE ..., ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2573)NX
 2573   FORMAT('      THE NUMER OF POINTS FOR THE X VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2574)NPTS
 2574   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2575)IHX,IHX2,NX
 2575   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2577)
 2577   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2578)(IANS(I),I=1,MIN(IWIDTH,80))
 2578     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NHOR.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2581)
 2581   FORMAT('***** ERROR IN DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2582)
 2582   FORMAT('      FOR A CROSS TABULATE ..., ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2583)NHOR
 2583   FORMAT('      THE NUMER OF POINTS FOR THE FIRST GROUP ',
     1         'VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2584)NPTS
 2584   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2585)IHHOR,IHHOR2,NHOR
 2585   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2587)
 2587   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2588)(IANS(I),I=1,MIN(IWIDTH,80))
 2588     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NHOR2.NE.NPTS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2591)
 2591   FORMAT('***** ERROR IN DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2592)
 2592   FORMAT('      FOR A CROSS TABULATE ..., ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2593)NHOR2
 2593   FORMAT('      THE NUMER OF POINTS FOR THE SECOND GROUP ',
     1         'VARIABLE,',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2594)NPTS
 2594   FORMAT('      WAS NOT EQUAL TO THE EXPECTED NUMBER OF ',
     1         'POINTS,',I8,' .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2595)IHHR2,IHHR22,NHOR2
 2595   FORMAT('        VARIABLE ',A4,A4,' HAS ',I8,' ELEMENTS, ',
     1         I8,' WERE EXPECTED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2597)
 2597   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2598)(IANS(I),I=1,MIN(IWIDTH,80))
 2598     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IYVAR.EQ.'OFF')THEN
        Y1(J)=0.0
      ELSE
        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)
      ENDIF
C
      IJ=MAXN*(ICOLX-1)+I
      IF(IXVAR.EQ.'OFF')THEN
        Z1(J)=0.0
      ELSE
        IF(ICOLX.LE.MAXCOL)Z1(J)=V(IJ)
        IF(ICOLX.EQ.MAXCP1)Z1(J)=PRED(I)
        IF(ICOLX.EQ.MAXCP2)Z1(J)=RES(I)
        IF(ICOLX.EQ.MAXCP3)Z1(J)=YPLOT(I)
        IF(ICOLX.EQ.MAXCP4)Z1(J)=XPLOT(I)
        IF(ICOLX.EQ.MAXCP5)Z1(J)=X2PLOT(I)
        IF(ICOLX.EQ.MAXCP6)Z1(J)=TAGPLO(I)
      ENDIF
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOLH2-1)+I
      IF(ICOLH2.LE.MAXCOL)X2(J)=V(IJ)
      IF(ICOLH2.EQ.MAXCP1)X2(J)=PRED(I)
      IF(ICOLH2.EQ.MAXCP2)X2(J)=RES(I)
      IF(ICOLH2.EQ.MAXCP3)X2(J)=YPLOT(I)
      IF(ICOLH2.EQ.MAXCP4)X2(J)=XPLOT(I)
      IF(ICOLH2.EQ.MAXCP5)X2(J)=X2PLOT(I)
      IF(ICOLH2.EQ.MAXCP6)X2(J)=TAGPLO(I)
C
 2660 CONTINUE
      NLOCAL=J
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  COMPUTE THE APPROPRIATE CROSS-TABULATION STATISTIC--   **
C               **  (MEAN, STANDARD DEVIATION, RANGE, OR COUNT).           **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CRTA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPCRT2(Y1,Z1,X1,X2,NLOCAL,NUMV2,ICASCT,ICTNAM,
     1XH1DIS,XH2DIS,TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ISEED,IQUAME,IQUASE,
     1IXVAR,IYVAR,
     1IYNAM,IXNAM,IX1NAM,IX2NAM,
     1ICAPSW,ICAPTY,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1MAXOBV,
     1Y,X,D,NPLOTP,ISUBRO,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CRTA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPCRTA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFOUND,IERROR
 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPLOTP,NS,ICASCT
 9013   FORMAT('NPLOTP,NS,ICASCT = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        IF(NPLOTP.GT.0)THEN
          DO9015I=1,NPLOTP
          WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016     FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
          CALL DPWRST('XXX','BUG ')
 9015     CONTINUE
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCRT2(Y,Z,TAG1,TAG2,N,NUMV2,ICASCT,ICTNAM,
     1XIDTEM,XIDTE2,TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1ISEED,IQUAME,IQUASE,
     1IXVAR,IYVAR,
     1IYNAM,IXNAM,IX1NAM,IX2NAM,
     1ICAPSW,ICAPTY,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1MAXNXT,
     1Y2,X2,D2,N2,ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A CROSS-TABULATION
C              OF THE FOLLOWING TYPES--
C                 1) MEAN CROSS-TABULATION;
C                 2) STANDARD DEVIATION CROSS-TABULATION;
C                 3) RANGE CROSS-TABULATION;
C                 4) COUNT CROSS-TABULATION.
C                 5) SUM CROSS-TABULATION`
C                 6) CHI-SQUARE ANALYSIS CROSS_TABULATION
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1989.  COMMENT OUT CHECK OF NUMSET=N
C     UPDATED         --DECEMBEDR 1989.  FIX CROSS-TAB X1 X2
C     UPDATED         --OCTOBER   1992.  SUPPRESS ERROR MESSAGE FOR
C                                        ZERO COUNT CELLS.
C                                        ADD SUM AND CHI-SQUARE OPTIONS
C     UPDATED         --MARCH     1994.  FIX CROSS TABU SUM CASE
C     UPDATED         --MARCH     1994.  MODIFY CROSS TABU CHI-SQUARE
C                                        OUTPUT
C     UPDATED         --DECEMBER  1998.  WRITE OUTPUT TO FILE
C     UPDATED         --AUGUST    2002.  USE CMPSTA TO COMPUTE THE
C                                        STATISTICS
C     UPDATED         --AUGUST    2002.  GREATLY EXPAND LIST OF
C                                        SUPPORTED STATISICS
C     UPDATED         --AUGUST    2002.  SUPPORT FOR HTML OUTPUT
C     UPDATED         --APRIL     2003.  ADD SN AND QN (AND DIFFERENCE
C                                        OF), REQUIRED ADDITIONAL
C                                        SCRATCH ARAYS
C     UPDATED         --OCTOBER   2003.  SUPPORT FOR LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASCT
      CHARACTER*40 ICTNAM
      CHARACTER*4 IXVAR
      CHARACTER*4 IYVAR
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*80 ITABTI
      CHARACTER*4 ITABBR
      CHARACTER*1 IBASLC
C
      CHARACTER*8 IYNAM
      CHARACTER*8 IXNAM
      CHARACTER*8 IX1NAM
      CHARACTER*8 IX2NAM
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC ADD FOLLOWING 2 LINES.  MARCH 1994.
      CHARACTER*10 ICONC1
      CHARACTER*10 ICONC2
C
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION XIDTEM(*)
      DIMENSION XIDTE2(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION TAG1(*)
      DIMENSION TAG2(*)
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
CCCCC OCTOBER 1992.  ADD FOLLOWING LINES.
      PARAMETER(MAXCRT=100)
      DIMENSION ROWTOT(MAXCRT)
      DIMENSION COLTOT(MAXCRT)
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
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='DPCR'
      ISUBN2='T2  '
C
      I2=0
C
      AN=0.0
      YUPPER=0.0
      YLOWER=0.0
C
      ANUMS1=0.0
      ANUMS2=0.0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.2)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPCRT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 2.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IYVAR.EQ.'OFF')GOTO69
      HOLD=Y(1)
      DO60I=1,N
      IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPCRT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPCRT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASCT,NUMV2
   71 FORMAT('N,ICASCT,NUMV2 = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),Z(I),TAG1(I),TAG2(I)
   73 FORMAT('I, Y(I), Z(I),TAG1(I),TAG2(I) = ',I8,5F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES         **
C               **  FOR THE GROUP VARIABLES (TAG1, TAG2)            **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS           **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE         **
C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.         **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DISTIN(TAG1,N,IWRITE,XIDTEM,NUMSE1,IBUGA3,IERROR)
      CALL SORT(XIDTEM,NUMSE1,XIDTEM)
      CALL DISTIN(TAG2,N,IWRITE,XIDTE2,NUMSE2,IBUGA3,IERROR)
      CALL SORT(XIDTE2,NUMSE2,XIDTE2)
C
      IF(NUMSE1.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,191)
  191   FORMAT('***** ERROR IN DPCRT2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,192)
  192   FORMAT('      NUMBER OF SETS    NUMSE1 = 0 ')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE2.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,193)
  193   FORMAT('***** ERROR IN DPCRT2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,194)
  194   FORMAT('      NUMBER OF SETS    NUMSE2 = 0 ')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE1.EQ.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,195)
  195   FORMAT('***** ERROR IN DPCRP2 SUBROUTINE--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,196)NUMSE1
  196   FORMAT('      NUMBER OF SETS FOR GROUP 1 VARIABLE ',I8,
     1         ' IDENTICAL TO ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,197)N
  197   FORMAT('      NUMBER OF OBSERVATIONS ',I8,' .')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(NUMSE2.EQ.N)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,195)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,206)NUMSE2
  206   FORMAT('      NUMBER OF SETS FOR GROUP 2 VARIABLE ',I8,
     1         ' IDENTICAL TO ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,197)N
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      AN=N
      ANUMS1=NUMSE1
      ANUMS2=NUMSE2
C
C               ***********************************************
C               **  STEP 5--                                 **
C               **  COMPUTE THE VARIOUS CROSS-TAB STATISTICS **
C               ***********************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      J=0
      DO1110ISET1=1,NUMSE1
        DO1120ISET2=1,NUMSE2
C
          K=0
          DO1130I=1,N
            IF(XIDTEM(ISET1).EQ.TAG1(I).AND.XIDTE2(ISET2).EQ.TAG2(I))
     1        GOTO1131
            GOTO1130
 1131       CONTINUE
C
            K=K+1
            IF(IYVAR.EQ.'OFF')THEN
              TEMP(K)=0.0
            ELSE
              TEMP(K)=Y(I)
              IF(IXVAR.EQ.'ON')TEMPZ(K)=Z(I)
            ENDIF
 1130     CONTINUE
          NTEMP=K
C
C         AUGUST 2002.  CALL CMPSTA (EXCEPT FOR CHI-SQUARE CASE)
C
          IF(ICASCT.EQ.'C2CT' .OR. ICASCT.EQ.'CSCT')THEN
            STAT=REAL(K)
          ELSE
            IF(NTEMP.EQ.0)THEN
              STAT=0.0
            ELSE
              CALL CMPSTA(
     1              TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,
     1              MAXNXT,NTEMP,NTEMP,
     1              NUMV2,ICASCT,
     1              ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1              IQUAME,IQUASE,
     1              STAT,
     1              ISUBRO,IBUGA3,IERROR)
            ENDIF
          ENDIF
C
          J=J+1
          Y2(J)=STAT
          X2(J)=XIDTEM(ISET1)
          D2(J)=XIDTE2(ISET2)
C
 1120   CONTINUE
 1110 CONTINUE
      N2=J
C
CCCCC OCTOBER 1992.  FOR CHI-SQUARE CASE, COMPUTE ROW AND COLUMN
CCCCC TOTALS, GRAND TOTAL.  COMPUTE CHI-SQUARE TEST STATISTIC.
C
      IF(ICASCT.NE.'CSCT'.AND.ICASCT.NE.'C2CT')GOTO4199
      IF(NUMSE1.GT.MAXCRT)THEN
      WRITE(ICOUT,2010)NUMSE1,MAXCRT
 2010 FORMAT(1X,'ERROR: THE NUMBER OF ROWS (',I6,') EXCCEDS THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2020)
 2020 FORMAT(1X,'ALLOWED MAXIMUM (',I3,')')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
      ENDIF
C
      IF(NUMSE2.GT.MAXCRT)THEN
      WRITE(ICOUT,2030)NUMSE2,MAXCRT
 2030 FORMAT(1X,'ERROR: THE NUMBER OF COLUMNS (',I6,') EXCCEDS THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2040)
 2040 FORMAT(1X,'ALLOWED MAXIMUM (',I3,')')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
      ENDIF
C
      J=0
      GTOTAL=0.0
C
      DO2110ISET1=1,NUMSE1
        ROWTOT(ISET1)=0.0
        DO2120ISET2=1,NUMSE2
          J=J+1
          ROWTOT(ISET1)=ROWTOT(ISET1)+Y2(J)
          GTOTAL=GTOTAL+Y2(J)
 2120   CONTINUE
        IF(IBUGA3.EQ.'ON')THEN
          WRITE(ICOUT,2122)ISET1,ROWTOT(ISET1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 2122   FORMAT('ISET1,ROWTOT(ISET1)=',I5,1X,F15.6)
 2110 CONTINUE
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,2125)GTOTAL
        CALL DPWRST('XXX','BUG ')
      ENDIF
 2125 FORMAT('GTOTAL=',F15.6)
C
      DO3110ISET2=1,NUMSE2
        COLTOT(ISET2)=0.0
        VALTMP=XIDTE2(ISET2)
        DO3120J=1,N2
          IF(D2(J).EQ.VALTMP)COLTOT(ISET2)=COLTOT(ISET2)+Y2(J)
 3120   CONTINUE
        IF(IBUGA3.EQ.'ON')THEN
          WRITE(ICOUT,3122)ISET2,COLTOT(ISET2)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 3122   FORMAT('ISET2,COLTOT(ISET2)=',I5,1X,F15.6)
 3110 CONTINUE
C
      CHISQ1=0.0
      CHISQ2=0.0
      J=0
C
      DO4110ISET1=1,NUMSE1
        DO4120ISET2=1,NUMSE2
          J=J+1
          EXP=ROWTOT(ISET1)*COLTOT(ISET2)/GTOTAL
          VALTMP=(Y2(J)-EXP)**2/EXP
          CHISQ1=CHISQ1+VALTMP
          VALTMP=ABS(Y2(J)-EXP)
          VALTMP=(VALTMP-0.5)**2/EXP
          CHISQ2=CHISQ2+VALTMP
 4120   CONTINUE
 4110 CONTINUE
C
 4199 CONTINUE
C
      GOTO6000
C
C               *****************************
C               **   STEP 6--              **
C               **   WRITE OUT THE TABLE   **
C               *****************************
C
 6000 CONTINUE
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='TAB2'
      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
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IF(ICASCT.EQ.'CSCT')GOTO7001
      IF(ICASCT.EQ.'C2CT')GOTO7001
C
CCCCC AUGUST 2002: IF CAPTURE SWITCH ON AND SET TO "HTML", THEN
CCCCC WRITE OUTPUT IN HTML TABLE FORMAT.
C
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5101)
 5101   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5102)
 5102   FORMAT('')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
 5199   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
        GOTO9000
CCCCC OCTOBER 2003: IF CAPTURE SWITCH ON AND SET TO "LATE", THEN
CCCCC WRITE OUTPUT IN LATEX TABLE FORMAT.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
C
        CALL DPCONA(92,IBASLC)
C
C  END VERBATIM, START TABLE ENVIRONMENT, TABLE TITLE
C
 8081 FORMAT(5X,'{',A1,'bf ',80A1)
 8181 FORMAT(5X,'{',A1,'bf Cross-Tabulated Values of the Statistic')
 8082 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8084 FORMAT(5X,'} ',A1,A1)
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(NCTABT.GT.0)THEN
          WRITE(ICOUT,8007)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8081)IBASLC,(ITABTI(I:I),I=1,NCTABT)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8084)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8082)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8082)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8010)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  START TABULAR ENVIRONMENT, VARIABLE NAMES
C
 8015 FORMAT(5X,A1,'begin{tabular} {|r|r|r|}')
 8115 FORMAT(5X,A1,'begin{tabular} {rrr}')
 8135 FORMAT(5X,A8,' & ',A8,' & ',A8,2X,A1,A1)
 8235 FORMAT(5X,A8,' & ',A8,' & ',A8,2X,A1,A1,2X,A1,'hline')
 8137 FORMAT(5X,A8,' & ',A8,' & ',A8,' AND ',A8,2X,A1,A1)
 8237 FORMAT(5X,A8,' & ',A8,' & ',A8,' AND ',A8,2X,A1,A1,
     1       2X,A1,'hline')
 8139 FORMAT(5X,' &  & ',A40,2X,A1,A1)
 8149 FORMAT(5X,A1,A1,2X,A1,'hline')
 8148 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ITABBR.EQ.'ON')THEN
          WRITE(ICOUT,8015)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8148)IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8115)IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(ITABBR.EQ.'RULE')THEN
            WRITE(ICOUT,8148)IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
        ENDIF
C
        WRITE(ICOUT,8139)ICTNAM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IF(IYVAR.EQ.'ON')THEN
          IF(IXVAR.EQ.'OFF')THEN
            IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
              WRITE(ICOUT,8235)IX1NAM,IX2NAM,IYNAM,
     1                         IBASLC,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8135)IX1NAM,IX2NAM,IYNAM,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            IF(ITABBR.EQ.'ON' .OR. ITABBR.EQ.'RULE')THEN
              WRITE(ICOUT,8237)IX1NAM,IX2NAM,IYNAM,IXNAM,
     1                         IBASLC,IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,8137)IX1NAM,IX2NAM,IYNAM,IXNAM,
     1                         IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ENDIF
        ENDIF
C
C  WRITE OUT TABULATED VALUES
C
 8210   FORMAT(5X,G15.6,' & ',G15.6,' & ',G15.6,2X,A1,A1)
 8211   FORMAT(5X,G15.6,' & ',G15.6,' & ',G15.6,2X,A1,A1,
     1         2X,A1,'hline')
        IF(ITABBR.EQ.'ON')THEN
          DO8200I=1,N2
            WRITE(ICOUT,8211)X2(I),Y2(I),IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8200     CONTINUE
        ELSE
          DO8260I=1,N2
            WRITE(ICOUT,8210)X2(I),D2(I),Y2(I),IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
 8260     CONTINUE
        ENDIF
C
C  END CODE
C
 8014   FORMAT(A1,'end{table}')
 8016   FORMAT('   ',A1,'end{tabular}')
 8017   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8016)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        GOTO9000
      ENDIF
C
      IF(IYVAR.EQ.'ON')THEN
        IF(IXVAR.EQ.'OFF')THEN
          WRITE(ICOUT,6107)IYNAM
 6107     FORMAT(31X,'*',4X,A8)
          CALL DPWRST('XXX','BUG ')
        ELSE
          WRITE(ICOUT,6109)IYNAM,IXNAM
 6109     FORMAT(31X,'*',4X,A8,' AND ',A8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
      WRITE(ICOUT,6111)IX1NAM,IX2NAM,ICTNAM
 6111 FORMAT(3X,A8,8X,A8,4X,'*    ',A40)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(IOUNI1,8111)ICTNAM
 8111 FORMAT(' GROUP-ID 1   GROUP-ID 2           ',A40)
      WRITE(ICOUT,6121)
 6121 FORMAT('************************************************',
     1       '**************')
      CALL DPWRST('XXX','BUG ')
      DO6160I=1,N2
      WRITE(ICOUT,6161)X2(I),D2(I),Y2(I)
 6161 FORMAT(G15.6,G15.6,' * ',G15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(IOUNI1,7161)X2(I),D2(I),Y2(I)
 7161 FORMAT(G15.6,G15.6,G15.6)
 6160 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IF(IPRINT.EQ.'OFF')GOTO9219
      WRITE(ICOUT,9212)
 9212 FORMAT(6X,'GROUP-IDs AND STATISTIC WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
 9219 CONTINUE
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
      GOTO9000
C
CCCCC OCTOBER 1992.  PRINT OUT CHI-SQUARE ANALYSIS
CCCCC MARCH 1994.  EXTENSIVELY REWRITE FOLLOWING SECTION TO HAVE
CCCCC OUTPUT MORE CONSISTENT WITH SOME OTHER DATAPLOT TESTS.
C
 7001 CONTINUE
      WRITE(ICOUT,7114)
 7114 FORMAT('                             ',22X,'ROW',4X,'COLUMN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7115)
 7115 FORMAT(30X,' * ',4X,'COUNTS',5X,'TOTAL',5X,'TOTAL',7X,'EXPECTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7121)
 7121 FORMAT(
     1'*************************************************************',
     1'*****************')
      CALL DPWRST('XXX','BUG ')
C
      J=0
      DO7210ISET1=1,NUMSE1
      DO7220ISET2=1,NUMSE2
      J=J+1
      EXP=ROWTOT(ISET1)*COLTOT(ISET2)/GTOTAL
      WRITE(ICOUT,7215)X2(J),D2(J),INT(Y2(J)),INT(ROWTOT(ISET1)),
     1INT(COLTOT(ISET2)),EXP
C7215 FORMAT(F10.3,F10.3,' * ',3I10,F12.2)
 7215 FORMAT(F15.6,F15.6,' * ',3I10,F15.6)
      CALL DPWRST('XXX','BUG ')
 7220 CONTINUE
 7210 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      IDF=(NUMSE1-1)*(NUMSE2-1)
      DF=REAL(IDF)
      CALL CHSCDF(CHISQ1,IDF,CDF1)
      IF(NUMSE1.EQ.2.AND.NUMSE2.EQ.2)CALL CHSCDF(CHISQ2,IDF,CDF2)
      ICONC1='REJECT'
      ICONC2='REJECT'
      IF(CDF1.LE.0.950)ICONC1='ACCEPT'
      IF(NUMSE1.EQ.2.AND.NUMSE2.EQ.2)THEN
        IF(CDF2.LE.0.950)ICONC2='ACCEPT'
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7311)
 7311 FORMAT(
     1'                  CHI-SQUARED TEST FOR INDEPENDENCE')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7340)
 7340 FORMAT('TEST:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7341)CHISQ1
 7341 FORMAT(3X,'CHI-SQUARED STATISTIC                 = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IF(NUMSE1.EQ.2.AND.NUMSE2.EQ.2)
     1WRITE(ICOUT,7342)CHISQ2
 7342 FORMAT(3X,'   WITH YATES CONTINUITY CORRECTION   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7251)DF
 7251 FORMAT(3X,'DEGREES OF FREEDOM                    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7253)CDF1
 7253 FORMAT(3X,'CHI-SQUARED CDF VALUE                 = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IF(NUMSE1.EQ.2.AND.NUMSE2.EQ.2)
     1WRITE(ICOUT,7254)CDF2
 7254 FORMAT(3X,'   WITH YATES CONTINUITY CORRECTION   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7261)
 7261 FORMAT('   HYPOTHESIS    ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7262)ICONC1
 7262 FORMAT('INDEPENDENT        ','(0.000,0.950)        ',A6)
      CALL DPWRST('XXX','WRIT')
C
      IF(NUMSE1.EQ.2.AND.NUMSE2.EQ.2)THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7270)
 7270 FORMAT('   WITH YATES CONTINUITY CORRECTION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7271)
 7271 FORMAT('   HYPOTHESIS    ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7272)ICONC2
 7272 FORMAT('INDEPENDENT        ','(0.000,0.950)        ',A6)
      CALL DPWRST('XXX','WRIT')
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
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 DPCRT2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASCT,N,NUMSE1,N2,IERROR
 9012 FORMAT('ICASCT,N,NUMSE1,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMSE1,NUMSE2,N2
 9015 FORMAT('NUMSE1,NUMSE2,N2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)ANUMS1,ANUMS2
 9016 FORMAT('ANUMS1,ANUMS2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I)
 9021 FORMAT('I,Y2(I),X2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCSTE(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A CHI-SQUARED TEST
C              (NECESSARILY 1-SAMPLE)
C     EXAMPLE--CHI-SQUARED TEST Y MU
C              CHI-SQUARED TEST MU Y
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/2
C     ORIGINAL VERSION--FEBRUARY  1994.
C     UPDATED         --DECEMBER  1994.  COPY CHI-SQUARED TEST PARAM.
C     UPDATED         --MAY       1995.  BUG FIX
C     UPDATED         --JANUARY   2004.  SUPPORT FOR HTML, LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      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
CCCCC MAY 1995.  ADD FOLLOWING 3 LINES
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
C
CCCCC MAY 1995.  ADD FOLLOWING LINE
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      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='DPTT'
      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
      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 CHI-SQUARED 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 DPCSTE--')
      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 COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IF(IARGT(1).EQ.'NUMB')GOTO1110
      IHWUSE='VORP'
      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
      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')GOTO1110
      GOTO1120
 1110 CONTINUE
      VALUE1=ARG(1)
      IUSE1='P'
      GOTO1190
 1120 CONTINUE
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
      GOTO1190
 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 DPCSTE--')
      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 CHI-SQUARED 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)
      IF(IARGT(2).EQ.'NUMB')GOTO2110
      IHWUSE='VORP'
      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
      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')GOTO2110
      GOTO2120
 2110 CONTINUE
      VALUE2=ARG(2)
      IUSE2='P'
      GOTO2190
 2120 CONTINUE
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
      GOTO2190
 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 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPCSTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR WHICH A CHI-SQUARED TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)MINN2
 2215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)IH21,IH22
 2217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)N2
 2218 FORMAT('      NUMBER OF OBSERVATIONS = ',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 31--                                                 **
C               **  FOR A CHI-SQUARED TEST,                                             **
C               **  AT LEAST ONE OF THE 2 ARGUMENTS                           **
C               **  MUST BE A VARIABLE (BUT NOT BOTH).                                **
C               **  CHECK FOR THIS.                                           **
C               **  IF ONLY 1 ARGUMENT IS A VARIABLE,                         **
C               **  THIS IMPLIES A 1-SAMPLE CHI-SQUARED TEST.                           **
C               **  (IF SO, COPY THE OTHER ARGUMENT AS THE TARGET MU VALUE).  **
C               **  IF BOTH ARGUMENTS ARE VARIABLES,                          **
C               **  THIS IMPLIES A 2-SAMPLE CHI-SQUARED TEST.                           **
C               ****************************************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V'.AND.IUSE2.NE.'V')GOTO3110
      IF(IUSE1.NE.'V'.AND.IUSE2.EQ.'V')GOTO3120
      IF(IUSE1.EQ.'V'.AND.IUSE2.EQ.'V')GOTO3130
      GOTO3140
C
 3110 CONTINUE
      NUMVAR=1
      ILOCV=1
      SIGMA0=VALUE2
      GOTO3190
 3120 CONTINUE
      NUMVAR=1
      ILOCV=2
      SIGMA0=VALUE1
      GOTO3190
 3130 CONTINUE
      NUMVAR=2
      GOTO3140
C
 3140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3141)
 3141 FORMAT('***** ERROR IN DPCSTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3142)
 3142 FORMAT('      FOR A CHI-SQUARED TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3143)
 3143 FORMAT('      EITHER THE FIRST ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3144)
 3144 FORMAT('      OR THE SECOND ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3145)
 3145 FORMAT('      (BUT NOT BOTH ARGUMENTS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3146)
 3146 FORMAT('      MUST BE A VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3147)
 3147 FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3148)
 3148 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)IH11,IH12
 3151 FORMAT('      ARGUMENT 1     : ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)IUSE1
 3152 FORMAT('      ARGUMENT 1 TYPE: ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IH21,IH22
 3153 FORMAT('      ARGUMENT 2     : ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)IUSE2
 3154 FORMAT('      ARGUMENT 2 TYPE: ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3155)
 3155 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3156)(IANS(I),I=1,IWIDTH)
 3156 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3190 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 DPCSTE--')
      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 T 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
      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 DPCSTE--')
      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 T 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               **  FORM THE T 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 DPCSTE, AS WE ARE ABOUT TO CALL DPCST2--')
      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
CCCCC THE FOLLOWING CALL WAS CHANGED       DECEMBER 1994
      CALL DPCST2(Y,NS1,X,NS2,SIGMA0,ILOCV,
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STATNU,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
CCCCC THE FOLLOWING SECTION WAS ADDED    DECEMBER 1994
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
CCCCC MAY 1995.  WRONG VARIABLE NAME.
CCCCC IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPCS'
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='NU  '
      VALUE0=STATNU
      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='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               **  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 DPCSTE--')
      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 DPCST2(Y1,N1,Y2,N2,SIGMA0,ILOCV,
CCCCC THE FOLLOWING LINE WAS CHANGED       DECEMBER 1994
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STATNU,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A CHI-SQUARED TEST
C              (NECESSARILY 1-SAMPLE)
C     EXAMPLE--CHI-SQUARED TEST Y SIGMA0
C              CHI-SQUARED TEST SIGMA0 Y
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                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--MAY       1984.
C     UPDATED         --APRIL     1987.  (LARRY KNAB CORRECTION--
C                                        BROWNLEE, P. 225)
C     UPDATED         --FEBRUARY  1994.  REFORMAT OUTPUT
C     UPDATED         --FEBRUARY  1994.  DPWRST: 'BUG ' => 'WRIT'
C     UPDATED         --DECEMBER  1994.  COPY CHI-SQUARED TEST PARAM.
C     UPDATED         --OCTOBER   2001.  MODIFY SOME OF THE
C                                        PRINT OUT FOR BETTER
C                                        CLARITY
C     UPDATED         --JANUARY   2004.  SUPPORT FOR HTML, LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 IBASLC
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
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='DPCS'
      ISUBN2='T2  '
C
      IERROR='NO'
C
      N=(-99)
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 DPCST2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,53)SIGMA0,ILOCV
   53 FORMAT('SIGMA0,ILOCV = ',E15.7,I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1
   55 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N1
      WRITE(ICOUT,57)I,Y1(I)
   57 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N2
   65 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N2
      WRITE(ICOUT,67)I,Y2(I)
   67 FORMAT('I,Y2(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(SIGMA0.GT.0)GOTO1109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1101)
 1101 FORMAT('***** ERROR IN DPCST2--THE SPECIFIED SIGMA0 IS',
     1'ZERO OR NEGATIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1102)SIGMA0
 1102 FORMAT('SIGMA0 = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1109 CONTINUE
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPCST2--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 DPCST2--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 DPCST2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
C               ******************************
C               **  STEP 31--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR A CHI-SQUARED TEST  **
C               ******************************
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      IF(ILOCV.EQ.1)THEN
         N=N1
         CALL MEAN(Y1,N1,IWRITE,YMEAN,IBUGA3,IERROR)
         CALL SD(Y1,N1,IWRITE,YSD,IBUGA3,IERROR)
      ELSEIF(ILOCV.EQ.2)THEN
         N=N2
         CALL MEAN(Y2,N2,IWRITE,YMEAN,IBUGA3,IERROR)
         CALL SD(Y2,N2,IWRITE,YSD,IBUGA3,IERROR)
      ENDIF
      AN=N
C
      RATIO=YSD/SIGMA0
      STAT=(AN-1.0)*RATIO**2
      DF=N-1
      IDF=DF+0.5
      CALL CHSCDF(STAT,IDF,CDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF.LE.0.025)ICONC1='ACCEPT'
      IF(CDF.LE.0.025 .OR. CDF.GE.0.975)ICONC2='ACCEPT'
      IF(CDF.GE.0.975)ICONC3='ACCEPT'
C
CCCCC THE FOLLOWING SECTION WAS ADDED      DECEMBER 1994
      STATVA=STAT
      STATCD=CDF
      STATNU=IDF
      CALL CHSPPF(.025,IDF,CUTL95)
      CALL CHSPPF(.975,IDF,CUTU95)
      CALL CHSPPF(.005,IDF,CUTL99)
      CALL CHSPPF(.995,IDF,CUTU99)
C
C               *******************************
C               **   STEP 32--               **
C               **   WRITE OUT EVERYTHING    **
C               **   FOR A CHI-SQUARED TEST  **
C               *******************************
C
      ISTEPN='32'
      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: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('
')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('')
 5094   FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5094)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('
')
 5194   FORMAT('
')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5194)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          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 CHI-SQUARE TEST: $',A1,'sigma_0$ = ',
     1       G15.7,'}')
 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,IBASLC,SIGMA0
        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} {lcr}')
 8021 FORMAT(5X,'$H_0$ Standard Deviation ($',A1,'sigma_0$) & = & ',
     1       G15.7,2X,A1,A1)
 8022 FORMAT(5X,'$H_a$ Standard Deviation ($',A1,'sigma_0$) & $',A1,
     1       'ne$ & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,' &   & ',2X,A1,A1)
 8024 FORMAT(5X,'{',A1,'bf Sample:} &   & ',2X,A1,A1)
 8025 FORMAT(5X,'Number of Observations & = & ',I8,2X,A1,A1)
 8026 FORMAT(5X,'Mean & = & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Standard Deviation (',A1,'em{s}) & = & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'{',A1,'bf Test:} &   & ',2X,A1,A1)
 8029 FORMAT(5X,A1,'em{s}/$',A1,'sigma_0$ & = & ', G15.7,2X,A1,A1)
 8030 FORMAT(5X,'Chi-Squared Test Statistic & = & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Degrees of Freedom & = & ',I8,2X,A1,A1)
 8032 FORMAT(5X,'Chi-Squared CDF Value & = & ',G15.7,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)IBASLC,SIGMA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC,SIGMA0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)YMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC,RATIO,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)STAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)INT(DF + 0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)CDF,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{center}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8109 FORMAT(A1,'begin{center}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120 FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121 FORMAT(5X,'& {',A1,'bf Alternative} & {',A1,
     1       'bf Alternative}',2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Alternative} & {',A1,
     1       'bf Hypothesis} & {',A1,'bf Hypothesis}',
     1       2X,A1,A1)
 8123 FORMAT(5X,'{',A1,'bf Hypothesis} & {',A1,
     1       'bf Acceptance Interval} & {',A1,
     1       'bf Conclusion}',2X,A1,A1)
 8124 FORMAT(5X,'$',A1,'sigma ',A1,'ne$ ',G15.7,
     1       ' & (0,0.025), (0.975,1) & ',
     1       A6,2X,A1,A1)
 8125 FORMAT(5X,'$',A1,'sigma <$ ',G15.7,' & (0,0.5) & ',
     1       A6,2X,A1,A1)
 8126 FORMAT(5X,'$',A1,'sigma >$ ',G15.7,' & (0.95,1) & ',
     1       A6,2X,A1,A1)
 8140 FORMAT(5X,A1,'hline')
 8149 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8123)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8124)IBASLC,IBASLC,SIGMA0,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8125)IBASLC,SIGMA0,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,SIGMA0,ICONC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191 FORMAT(A1,'end{center}')
 8193 FORMAT(A1,'end{table}')
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE IN RTF (RICH TEXT FORMAT)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3211)
 3211   FORMAT('                  CHI-SQUARED TEST: SIGMA0 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3213)SIGMA0
 3213   FORMAT('NULL HYPOTHESIS:       STANDARD DEVIATION (SIGMA0) = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3215)SIGMA0
 3215   FORMAT('ALTERNATE HYPOTHESIS:  STANDARD DEVIATION (SIGMA0) = ',
     1         G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3220)
 3220   FORMAT('SAMPLE:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3221)N
 3221   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3222)YMEAN
 3222   FORMAT(3X,'MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3223)YSD
 3223   FORMAT(3X,'STANDARD DEVIATION S        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3240)
 3240   FORMAT('TEST:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3241)RATIO
 3241   FORMAT(3X,'S/SIGMA0                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3242)STAT
 3242   FORMAT(3X,'CHI-SQUARED STATISTIC       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3243)DF
 3243   FORMAT(3X,'DEGREES OF FREEDOM          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3244)CDF
 3244   FORMAT(3X,'CHI-SQUARED CDF VALUE       = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3248)
 3248   FORMAT(
     1  '                    ALTERNATIVE-          ALTERNATIVE-')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3250)
 3250   FORMAT(
     1  '   ALTERNATIVE-     HYPOTHESIS            HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3251)
 3251   FORMAT('   HYPOTHESIS       ACCEPTANCE INTERVAL   CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3253)SIGMA0,ICONC2
 3253   FORMAT('SIGMA <> ',G12.7,'(0,0.025), (0.975,1)  ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3252)SIGMA0,ICONC1
 3252   FORMAT('SIGMA <  ',G12.7,'(0,0.05)              ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3254)SIGMA0,ICONC3
 3254   FORMAT('SIGMA >  ',G12.7,'(0.95,1)              ',A6)
        CALL DPWRST('XXX','WRIT')
        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 DPCST2--')
      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)SIGMA0,ILOCV
 9013 FORMAT('SIGMA0,ILOCV = ',E15.7,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 DPCUBE(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE CUBES
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE OPPOSING CORNERS
C           OF (THE FRONT FACE OF) THE CUBE.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CUBE WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CUBE WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN CUBE WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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     1987.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      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'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CUBE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCUBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 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
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='CUBE'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPCUBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A CUBE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE FRONT FACE CORNER AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND THE FRONT FACE OPPOSITE CORNER AT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      CUBE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      CUBE ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPCUB2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CUBE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCUBE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCUB2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A CUBE
C              WITH ONE FRONT FACE CORNER AT (X1,Y1)
C              AND THE FRONT FACE OPPOSITE CORNER AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/5
C     ORIGINAL VERSION--APRIL     1987.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(20)
      DIMENSION PY(20)
CCCCC DIMENSION PX3(20)
CCCCC DIMENSION PY3(20)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      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
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CUB2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPCUB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  SET THE SPECS              **
C               **  WHICH CONTROL THE          **
C               **  APPEARANCE OF THE          **
C               **  RESULTING CUBE.            **
C               *********************************
C
      DELX=ABS(X2-X1)
      DELY=ABS(Y2-Y1)
      DELMIN=DELX
CCCCC IF(DELY.LT.DELX)DELMIN=DELY
      P3D=0.3
      DEL3D=P3D*DELMIN
C
C               *************************
C               **  STEP 2--           **
C               **  FILL THE FIGURE    **
C               **  (IF CALLED FOR)    **
C               *************************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
C
      IPATT=IREPTY(1)
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
C
      IF(IREFSW(1).EQ.'ON')GOTO2110
      IF(IREFSW(1).EQ.'ONF')GOTO2110
      IF(IREFSW(1).EQ.'ONS')GOTO2120
      IF(IREFSW(1).EQ.'ONT')GOTO2130
      IF(IREFSW(1).EQ.'ONFS')GOTO2110
      IF(IREFSW(1).EQ.'ONSF')GOTO2110
      IF(IREFSW(1).EQ.'ONFT')GOTO2110
      IF(IREFSW(1).EQ.'ONTF')GOTO2110
      IF(IREFSW(1).EQ.'ONST')GOTO2120
      IF(IREFSW(1).EQ.'ONTS')GOTO2120
C
C               ********************************
C               **  STEP 2.1--                **
C               **  FRONT FACE ONLY           **
C               ********************************
C
 2110 CONTINUE
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y1
C
      PX(3)=X2
      PY(3)=Y2
C
      PX(4)=X1
      PY(4)=Y2
C
      PX(5)=X1
      PY(5)=Y1
C
      NP=5
C
      IPATT2='SOLI'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      IF(IREFSW(1).EQ.'ON')GOTO2120
      IF(IREFSW(1).EQ.'ONF')GOTO2190
      IF(IREFSW(1).EQ.'ONS')GOTO2120
      IF(IREFSW(1).EQ.'ONT')GOTO2130
      IF(IREFSW(1).EQ.'ONFS')GOTO2120
      IF(IREFSW(1).EQ.'ONSF')GOTO2120
      IF(IREFSW(1).EQ.'ONFT')GOTO2130
      IF(IREFSW(1).EQ.'ONTF')GOTO2130
      IF(IREFSW(1).EQ.'ONST')GOTO2120
      IF(IREFSW(1).EQ.'ONTS')GOTO2120
C
C               ********************************
C               **  STEP 2.2--                **
C               **  SIDE (= RIGHT) FACE ONLY  **
C               ********************************
C
C
 2120 CONTINUE
      PX(1)=X2
      PY(1)=Y2
C
      PX(2)=X2+DEL3D
      PY(2)=Y2+DEL3D
C
      PX(3)=X2+DEL3D
      PY(3)=Y1+DEL3D
C
      PX(4)=X2
      PY(4)=Y1
C
      PX(5)=X2
      PY(5)=Y2
C
      NP=5
C
      IPATT2='SOLI'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      IF(IREFSW(1).EQ.'ON')GOTO2130
      IF(IREFSW(1).EQ.'ONF')GOTO2190
      IF(IREFSW(1).EQ.'ONS')GOTO2190
      IF(IREFSW(1).EQ.'ONT')GOTO2130
      IF(IREFSW(1).EQ.'ONFS')GOTO2190
      IF(IREFSW(1).EQ.'ONSF')GOTO2190
      IF(IREFSW(1).EQ.'ONFT')GOTO2130
      IF(IREFSW(1).EQ.'ONTF')GOTO2130
      IF(IREFSW(1).EQ.'ONST')GOTO2130
      IF(IREFSW(1).EQ.'ONTS')GOTO2130
C
C               ********************************
C               **  STEP 2.3--                **
C               **  TOP FACE ONLY             **
C               ********************************
C
 2130 CONTINUE
      PX(1)=X1
      PY(1)=Y2
C
      PX(2)=X1+DEL3D
      PY(2)=Y2+DEL3D
C
      PX(3)=X2+DEL3D
      PY(3)=Y2+DEL3D
C
      PX(4)=X2
      PY(4)=Y2
C
      PX(5)=X1
      PY(5)=Y2
C
      NP=5
C
      IPATT2='SOLI'
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y1
C
      PX(3)=X2
      PY(3)=Y2
C
      PX(4)=X1
      PY(4)=Y2
C
      PX(5)=X1
      PY(5)=Y1
C
      NP=5
C
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      PX(1)=X1
      PY(1)=Y2
C
      PX(2)=X1+DEL3D
      PY(2)=Y2+DEL3D
C
      PX(3)=X2+DEL3D
      PY(3)=Y2+DEL3D
C
      PX(4)=X2
      PY(4)=Y2
C
      NP=4
C
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      PX(1)=X2+DEL3D
      PY(1)=Y2+DEL3D
C
      PX(2)=X2+DEL3D
      PY(2)=Y1+DEL3D
C
      PX(3)=X2
      PY(3)=Y1
C
      NP=3
C
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CUB2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPCUB2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IREFSW(1),IREFCO(1)
 9021 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)DELX,DELY,DELMIN,P3D,DEL3D
 9022 FORMAT('DELX,DELY,DELMIN,P3D,DEL3D = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPCUCO(IHARG,IARGT,ARG,NUMARG,PDIAYC,
     1PDIAY2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE (VERTICAL) COORDINATE FOR THE CURSOR
C              THE COORDINATE FOR THE CURSOR WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PDIAY2.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDIAYC
C     OUTPUT ARGUMENTS--PDIAY2
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/7
C     ORIGINAL VERSION--APRIL     1986.
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.1)GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      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
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPCUCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR CURSOR COORDINATES ',
     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 TO HAVE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE CURSOR COORDINATE TO BE 20 PERCENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      OF THE WAY UP THE SCREEN (FROM THE BOTTOM), ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      CURSOR COORDINATE 20')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      PDIAY2=PDIAYC
      GOTO1180
C
 1160 CONTINUE
      PDIAY2=ARG(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)PDIAY2
 1181 FORMAT('THE CURSOR COORDINATE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCUSP(IHARG,IARGT,ARG,NUMARG,DEFCSP,
     1PDIAVG,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPACING (= VERTICAL GAP) FOR THE CURSOR
C              THE SPACING FOR THE CURSOR WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PDIAVG.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --DEFCSP
C     OUTPUT ARGUMENTS--PDIAVG
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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/7
C     ORIGINAL VERSION--APRIL     1986.
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.1)GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      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
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPCUSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR CURSOR SPACING ',
     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 TO HAVE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE CURSOR SPACING TO BE 2 PERCENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      OF TOTAL SCREEN HEIGHT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      CURSOR SPACING 2')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      PDIAVG=DEFCSP
      GOTO1180
C
 1160 CONTINUE
      PDIAVG=ARG(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)PDIAVG
 1181 FORMAT('THE CURSOR SPACING HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCUSU(XTEMP1,MAXNXT,
     1ICASAN,ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--PERFORM A CUMULATIVE SUM TEST FOR RANDOMNESS
C     EXAMPLE--CUMULATIVE SUM TEST Y
C     REFERENCE--A STATISTICAL TEST SUITE FOR RANDOM AND PSUEDORANDOM
C                NUMBER GENERATORS FOR CRYPTOGRAPHIC APPLICATIONS,
C                ANDREW RUKHIN, JUAN SOTO, JAMES NECHVATAL, MILES SMID,
C                ELAINE BARKER, STEFAN LEIGH, MARK LEVENSON,
C                MARK VANGEL, DAVID BANKS, ALAN HECKERT, JAMES DRAY,
C                SAN VO.  NIST SPECIAL PUBLICATION 800-22,
C                OCTOBER 2000, PP. 14-16.
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 BUREAU OF STANDARDS.
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/12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
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)
      DIMENSION YTEMP2(MAXOBV)
      DIMENSION YTEMP3(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),YTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB2),YTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP3(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='DPFR'
      ISUBN2='TE  '
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 CUMULATIVE SUM   TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CUSU')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPCUSU--')
        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 ')
      ENDIF
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' .OR. ISUBRO.EQ.'CUSU')
     1CALL 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 DPCUSU--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE CUMULATIVE SUM 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)THEN
           WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         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' .OR. ISUBRO.EQ.'CUSU')
     1CALL 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 DPCUSU--')
      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 CUMULATIVE 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)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' .OR. ISUBRO.EQ.'CUSU')
     1CALL 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.'ON' .OR. ISUBRO.EQ.'CUSU')THEN
        WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
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' .OR. ISUBRO.EQ.'CUSU')
     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 DPCUSU--')
      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 CUMULATIVE 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)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 CUMULATIVE SUM TEST   **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CUSU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CUSU')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5211)
 5211   FORMAT('***** FROM DPCUSU, AS WE ARE ABOUT TO CALL DPCUS2--')
        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 ')
      ENDIF
C
 5790 CONTINUE
C
      CALL DPCUS2(Y,NS1,
     1XTEMP1,MAXNXT,
     1ICAPSW,ICAPTY,ICASAN,M,
     1STATVA,STATCD,
     1YTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'CUSU')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPCU'
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
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'CUSU')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPCUSU--')
        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 ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCUS2(Y,N,
     1XTEMP,MAXNXT,
     1ICAPSW,ICAPTY,ICASAN,M,
     1STATVA,STATCD,
     1YTEMP1,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT THE CUMULATIVE SUM TEST
C              FOR RANDOMNESS OR THE FREQUENCY WITHIN A BLOCK TEST
C              FOR RANDOMNESS.
C     EXAMPLE--CUMULATIVE SUM TEST Y
C     REFERENCE--A STATISTICAL TEST SUITE FOR RANDOM AND PSUEDORANDOM
C                NUMBER GENERATORS FOR CRYPTOGRAPHIC APPLICATIONS,
C                ANDREW RUKHIN, JUAN SOTO, JAMES NECHVATAL, MILES SMID,
C                ELAINE BARKER, STEFAN LEIGH, MARK LEVENSON,
C                MARK VANGEL, DAVID BANKS, ALAN HECKERT, JAMES DRAY,
C                SAN VO.  NIST SPECIAL PUBLICATION 800-22,
C                OCTOBER 2000, PP. 14-18.
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 BUREAU OF STANDARDS.
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/12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICASAN
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*1 IBASLC
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
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DSUM4
      DOUBLE PRECISION DZ1
      DOUBLE PRECISION DZ2
      DOUBLE PRECISION DCDF1
      DOUBLE PRECISION DCDF2
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='DPCU'
      ISUBN2='S2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CUS2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPCUS2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','BUG ')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I)
   57     FORMAT('I,Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
   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.'CUS2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN CUMULATIVE SUM RANDOMNESS TEST.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1113)
 1113   FORMAT('      AT LEAST SIX OBSERVATIONS REQUIRED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1115)N
 1115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','BUG ')
        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','BUG ')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM CUMULATIVE SUM RANDOMNESS TEST--',
     1'VARIABLE HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               *******************************
C               **  STEP 2--                 **
C               **  COMPUTE THE NUMBER OF    **
C               **  DISTINCT VALUES.         **
C               *******************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'CUS2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='NO'
      CALL DISTIN(Y,N,IWRITE,YTEMP1,NDIST,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
      IF(NDIST.NE.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2001)
 2001   FORMAT('***** ERROR IN CUMULATIVE SUM RANDOMNESS TEST.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2003)
 2003   FORMAT('      FOR CUMULATIVE SUM TEST, EXACTLY TWO DISTINCT ',
     1         'VALUES ARE ALLOWED.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2005)NDIST
 2005   FORMAT('      NUMBER OF DISTINCT VALUES = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ******************************
C               **  STEP 42--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR CUSUM         TEST  **
C               ******************************
C
 4400 CONTINUE
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      ALOW=MIN(YTEMP1(1),YTEMP1(2))
      AHIGH=MAX(YTEMP1(1),YTEMP1(2))
      DZ1=0.0D0
      DZ2=0.0D0
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DSUM4=0.0D0
C
      DO2020I=1,N
        IF(Y(I).EQ.ALOW)THEN
          DSUM1=DSUM1 - 1.0
        ELSE
          DSUM1=DSUM1 + 1.0
        ENDIF
        DZ1=MAX(DZ1,ABS(DSUM1))
 2020 CONTINUE
C
      DO2030I=N,1,-1
        IF(Y(I).EQ.ALOW)THEN
          DSUM2=DSUM2 - 1.0
        ELSE
          DSUM2=DSUM2 + 1.0
        ENDIF
        DZ2=MAX(DZ2,ABS(DSUM2))
 2030 CONTINUE
C
      AN=REAL(N)
      Z1=REAL(DZ1)/SQRT(AN)
      Z2=REAL(DZ2)/SQRT(AN)
      STATVA=Z1
      STATV2=Z2
C
      DSUM1=0.0D0
      DSUM2=0.0D0
C
      ATEMP=((AN/Z1)-1.0)/4.0
      IUPP=INT(ATEMP)
      ATEMP=((-AN/Z1)+1.0)/4.0
      ILOW=INT(ATEMP)
      DSUM1=0.0D0
      DO2110K=ILOW,IUPP
        AK=REAL(K)
        ATEMP=(4.0*AK+1.0)*Z1
        CALL NODCDF(DBLE(ATEMP),DCDF1)
        ATEMP=((4.0*AK - 1.0)*Z1)
        CALL NODCDF(DBLE(ATEMP),DCDF2)
        DSUM1=DSUM1 + (DCDF1 - DCDF2)
 2110 CONTINUE
C
      ATEMP=((AN/Z1)-3.0)/4.0
      IUPP=INT(ATEMP)
      ATEMP=((-AN/Z1)-1.0)/4.0
      ILOW=INT(ATEMP)
      DO2120K=ILOW,IUPP
        AK=REAL(K)
        ATEMP=(4.0*AK+3.0)*Z1
        CALL NODCDF(DBLE(ATEMP),DCDF1)
        ATEMP=((4.0*AK + 1.0)*Z1)
        CALL NODCDF(DBLE(ATEMP),DCDF2)
        DSUM2=DSUM2 + (DCDF1 - DCDF2)
 2120 CONTINUE
C
      ATEMP=((AN/Z2)-1.0)/4.0
      IUPP=INT(ATEMP)
      ATEMP=((-AN/Z2)+1.0)/4.0
      ILOW=INT(ATEMP)
      DSUM3=0.0D0
      DO2130K=ILOW,IUPP
        ATEMP=(4.0*REAL(K)+1.0)*Z2
        CALL NODCDF(DBLE(ATEMP),DCDF1)
        ATEMP=((4.0*REAL(K) - 1.0)*Z2)
        CALL NODCDF(DBLE(ATEMP),DCDF2)
        DSUM3=DSUM3 + (DCDF1 - DCDF2)
 2130 CONTINUE
C
      ATEMP=((AN/Z2)-3.0)/4.0
      IUPP=INT(ATEMP)
      ATEMP=((-AN/Z2)-1.0)/4.0
      ILOW=INT(ATEMP)
      DSUM4=0.0D0
      DO2140K=ILOW,IUPP
        ATEMP=(4.0*REAL(K)+3.0)*Z2
        CALL NODCDF(DBLE(ATEMP),DCDF1)
        ATEMP=((4.0*REAL(K) + 1.0)*Z2)
        CALL NODCDF(DBLE(ATEMP),DCDF2)
        DSUM4=DSUM4 + (DCDF1 - DCDF2)
 2140 CONTINUE
C
      STATCD=REAL(1.0D0 - DSUM1 + DSUM2)
      STATC2=REAL(1.0D0 - DSUM3 + DSUM4)
C
C               *********************************
C               **   STEP 52--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR CUMULATIVE SUM TEST   **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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')
        WRITE(ICOUT,5108)
 5108   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5102)
 5102   FORMAT('CUMULATIVE SUM TEST FOR RANDONNESS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5109)
 5109   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5104)
C5104   FORMAT('

')
CCCCC
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5105)
 5105   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5206)
 5206   FORMAT('   
  1. Hypotheis:
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5208)
 5208   FORMAT('       H0: The data are random
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5210)
 5210   FORMAT('       Ha: The data are not random
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5106)
 5106   FORMAT('   
  2. Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('       
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('       ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
 5121   FORMAT('         ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5146)
 5146   FORMAT('               Cumulative Sum Test Statstic Value:',
     1         '
    (Forward Direction)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)STATVA
 5154   FORMAT('            ',G15.7)
        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,5147)
 5147   FORMAT('               Cumulative Sum Test Statstic Value:',
     1         '
    (Backward Direction)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)STATV2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5191)
 5191   FORMAT('       
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
 5125   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('            ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)N
 5129   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('         
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5171)STATCD
 5171   FORMAT('   
  3. P-Value = ',G15.7,' (Forward Direction)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)STATC2
 5173   FORMAT('       
    P-Value = ',G15.7,
     1         ' (Backward Direction)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('       (Reject hypothesis of randomness if P-Value ',
     1         'is less than alpha)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5176)
 5176   FORMAT('   
  4. Conclusion (at the 5% Level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.GE.0.05)THEN
          WRITE(ICOUT,5180)
          CALL DPWRST('XXX','WRIT')
 5180     FORMAT('        The data are random (forward direction).')
        ELSE
          WRITE(ICOUT,5190)
          CALL DPWRST('XXX','WRIT')
 5190     FORMAT('        The data are not random ',
     1           '(forward direction).')
        ENDIF
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        IF(STATV2.GE.0.05)THEN
          WRITE(ICOUT,5182)
          CALL DPWRST('XXX','WRIT')
 5182     FORMAT('        The data are random (backward direction).')
        ELSE
          WRITE(ICOUT,5192)
          CALL DPWRST('XXX','WRIT')
 5192     FORMAT('        The data are not random ',
     1           '(backward direction).')
        ENDIF
        WRITE(ICOUT,5997)
 5997   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5999)
 5999   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf CUMULATIVE SUM TEST FOR RANDOMNESS}',2X,A1,A1)
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8007   FORMAT(A1,'begin{center}')
 8008   FORMAT(A1,'end{center}')
 8012   FORMAT(A1,'end{verbatim}')
 8017   FORMAT(A1,'begin{enumerate}')
 8018   FORMAT(A1,'end{enumerate}')
 8019   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(5X,A1,'item Hypothesis:')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Critical Values:')
 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)
 8034   FORMAT(11X,'Cumulative Sum Test Statistic Value: & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(11X,'(Forward Direction): & ',2X,A1,A1)
 8036   FORMAT(11X,'(Backward Direction): & ',2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8151   FORMAT(11X,'$H_0$: The data are random ')
 8152   FORMAT(11X,'$H_a$: The data are not random')
C
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8151)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8152)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)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,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATV2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)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')
C
 8046   FORMAT(11X,'P-Value of Statistic: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'(Reject hypothesis of randomness if p-value ',
     1         'is less than $',A1,'alpha$) & ',2X,A1,A1)
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)STATCD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)STATC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)IBASLC,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,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8050   FORMAT(11X,A1,'newline')
 8091   FORMAT(A1,'end{enumerate}')
 8092   FORMAT(A1,'begin{verbatim}')
        IF(STATVA.GE.0.05)THEN
          WRITE(ICOUT,8051)
          CALL DPWRST('XXX','WRIT')
 8051     FORMAT('        The data are random (forward direction).')
        ELSE
          WRITE(ICOUT,8061)
          CALL DPWRST('XXX','WRIT')
 8061     FORMAT('        The data are not random ',
     1          '(forward direction).')
        ENDIF
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.GE.0.05)THEN
          WRITE(ICOUT,8052)
          CALL DPWRST('XXX','WRIT')
 8052     FORMAT('        The data are random (backward direction).')
        ELSE
          WRITE(ICOUT,8062)
          CALL DPWRST('XXX','WRIT')
 8062     FORMAT('        The data are not random ',
     1          '(backward direction).')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5211)
 5211   FORMAT('              CUMULATIVE SUM TEST FOR RANDOMNESS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5231)
 5231   FORMAT('1. HYPOTHESIS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5232)
 5232   FORMAT(3X,'H0: THE DATA ARE RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5233)
 5233   FORMAT(3X,'HA: THE DATA ARE NOT RANDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
 5241   FORMAT('2. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5242)N
 5242   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5345)STATVA
 5345   FORMAT(3X,'CUMULATIVE SUM TEST STATISTIC    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5346)
 5346   FORMAT(3X,'(FORWARD DIRECTION)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5347)STATV2
 5347   FORMAT(3X,'CUMULATIVE SUM TEST STATISTIC    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5348)
 5348   FORMAT(3X,'(BACKWARD DIRECTION)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5451)STATCD
 5451   FORMAT('3. P-VALUE OF STATISTIC  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5346)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5453)STATCD
 5453   FORMAT('   P-VALUE OF STATISTIC  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5348)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5454)
 5454   FORMAT('   (REJECT HYPOTHESIS OF RANDOMNESS IF P-VALUE IS ',
     1         'LESS THAN ALPHA)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5561)
 5561   FORMAT('4. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.GE.0.05)THEN
          WRITE(ICOUT,5563)
 5563     FORMAT(3X,'THE DATA ARE RANDOM (FORWARD DIRECTION).')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5565)
 5565     FORMAT(3X,'THE DATA ARE NOT RANDOM (FORWARD DIRECTION).')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(STATV2.GE.0.05)THEN
          WRITE(ICOUT,5573)
 5573     FORMAT(3X,'THE DATA ARE RANDOM (BACKWARD DIRECTION).')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5575)
 5575     FORMAT(3X,'THE DATA ARE NOT RANDOM (BACKWARD DIRECTION).')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        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.'CUS2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPCUS2--')
        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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPCUSZ(IHARG,IARGT,ARG,NUMARG,DEFCSZ,
     1ACURSZ,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SIZE FOR THE CURSOR
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE SIZE FOR THE CURSOR WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ACURSZ.
C              (NOTE THAT THE IMPORTANT VARIABLE PDIAHE
C              IS USUALLY SET
C              EQUAL TO ACURSZ IN THE CALLING ROUTINE
C              AFTER THE CALL TO THIS SUBROUTINE).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --DEFCSZ
C     OUTPUT ARGUMENTS--ACURSZ
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
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--JANUARY   1980.
C     UPDATED         --MAY       1982.
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.LE.0)GOTO1199
      IF(IHARG(1).NE.'SIZE')GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      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
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPCUSZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR CURSOR SIZE ',
     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 TO HAVE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE CURSOR ONE AND ONE HALF TIMES AS BIG ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AS THE DEFAULT SIZE (WHICH IS SIZE 1), ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      CURSOR SIZE 1.5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      ACURSZ=DEFCSZ
      GOTO1180
C
 1160 CONTINUE
      ACURSZ=ARG(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)ACURSZ
 1181 FORMAT('THE CURSOR SIZE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPCYGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CYCLE THROUGH THE CURRENTLY SAVED PIXMAPS
C
C                  CYCLE GRAPHS  (OR CYCLE PLOT, CG, CP)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGU
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/4
C     ORIGINAL VERSION--APRIL     1997.
C     UPDATED         --AUGUST    1997. MOVE SOME CODE TO A LOWER LEVEL
C                                       TO SUPPORT NON-X11 DEVICES
C                                       (SPECIFICALLY PC FOR NOW)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 ICODE
      CHARACTER*256 ISTRI2
      CHARACTER*128 CTEMP
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
CCCCC DIMENSION IADE(128)
CCCCC DIMENSION IADE2(128)
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPM.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.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='DPLI'
      ISUBN2='GR  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CYGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPCYGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IFOUND,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               *******************************
C               **  STEP 12--                **
C               **  CALL XCYCLE              **
C               *******************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'CYGR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMPXM.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1203)
        CALL DPWRST('XXX','BUG')
        IERROR='YES'
        GOTO9000
      ELSE
        IF(IFEEDB.EQ.'ON')THEN
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1213)
          CALL DPWRST('XXX','BUG')
          WRITE(ICOUT,1215)
          CALL DPWRST('XXX','BUG')
          WRITE(ICOUT,1217)
          CALL DPWRST('XXX','BUG')
          IF(ICOMPI.EQ.'MS-F')THEN
            WRITE(ICOUT,1221)
          ELSE
            WRITE(ICOUT,1219)
          ENDIF
          CALL DPWRST('XXX','BUG')
        ENDIF
      ENDIF
 1203 FORMAT('***** THERE ARE FEWER THAN TWO CURRENTLY SAVED PIMAPS.')
 1213 FORMAT('***** TO CYCLE THROUGH THE PREVIOUSLY SAVED GRAPHS:')
 1215 FORMAT('      1. CLICK THE LEFT MOUSE BUTTON TO CYCLE BACK.')
 1217 FORMAT('      2. CLICK THE RIGHT MOUSE BUTTON TO CYCLE FORWARD.')
 1219 FORMAT('      3. CLICK THE MIDDLE MOUSE BUTTON TO STOP CYCLING.')
 1221 FORMAT('      3. HOLD SHIFT OR CONTROL KEY DOWN WHILE CLICKING ',
     1'THE LEFT OR RIGHT BUTTON TO STOP CYCLING.')
C
C  AUGUST 1997.  IN ORDER TO GENERALIZE THE CODE TO NON-X11 DEVICES,
C  MOVE FOLLOWING CODE TO LOWER LEVEL ROUTINE.
C
      ICODE='CYCL'
      ISTRI2=' '
      CTEMP=' '
      NCSTR2=0
      NCTEMP=0
      CALL GRSAGR(ICODE,ISTRI2,NCSTR2,CTEMP,NCTEMP)
C
C1000 CONTINUE
CCCCC IERR=0
CCCCC CALL XCYCLE(IERR,IBUTTN)
CCCCC IF(IERR.EQ.4)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1310)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
CCCCC ELSEIF(IERR.NE.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1310)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
CCCCC ENDIF
C1310 FORMAT('***** ERROR FROM DPCYGR: X11 NOT ACTIVE ON THIS ',
CCCCC1'IMPLEMENTATION.')
C1311 FORMAT('***** ERROR FROM DPCYGR: ERROR TRYING TO REDRAW PIXMAP.')
CCCCC IF(IBUTTN.EQ.1)THEN
CCCCC   ICURPM=ICURPM-1
CCCCC   IF(ICURPM.LT.1)ICURPM=1
CCCCC ELSEIF(IBUTTN.EQ.3)THEN
CCCCC   ICURPM=ICURPM+1
CCCCC   IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
CCCCC ELSE
CCCCC   GOTO9000
CCCCC ENDIF
C
CCCCC NCSTR2=1
CCCCC DO1405I=128,1,-1
CCCCC   NCSTR2=I
CCCCC   IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO1409
C1405 CONTINUE
C1409 CONTINUE
CCCCC CTEMP=' '
CCCCC IF(ICURPM.LE.9)THEN
CCCCC   CTEMP(1:4)='  - '
CCCCC   WRITE(CTEMP(1:1),'(I1)')ICURPM
CCCCC   NCTEMP=4
CCCCC ELSEIF(ICURPM.LE.99)THEN
CCCCC   CTEMP(1:5)='   - '
CCCCC   WRITE(CTEMP(1:2),'(I2)')ICURPM
CCCCC   NCTEMP=5
CCCCC ELSEIF(ICURPM.LE.999)THEN
CCCCC   CTEMP(1:6)='    - '
CCCCC   WRITE(CTEMP(1:3),'(I3)')ICURPM
CCCCC   NCTEMP=6
CCCCC ENDIF
CCCCC DO1415I=1,NCTEMP
CCCCC   CALL DPCOAN(CTEMP(I:I),IADE2(I))
C1415 CONTINUE
CCCCC DO1420I=1,NCSTR2
CCCCC   CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE(I))
CCCCC   CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE2(I+NCTEMP))
C1420 CONTINUE
CCCCC IADE(NCSTR2+1)=0
CCCCC IADE2(NCSTR2+NCTEMP+1)=0
CCCCC IERR=0
CCCCC CALL XRESTG(IADE,IADE2,IERR)
CCCCC IF(IERR.NE.0)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1310)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
CCCCC ENDIF
C
CCCCC GOTO1000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'CYGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END