      SUBROUTINE DPBABA(ADEBBA,MAXBAR,ABARBA,
CCCCC OCTOBER 1993.  ABOVE LINE MODIFIED (DPCOHK.INC NOW INCLUDED
CCCCC IN THIS ROUTINE, SO NO NEED TO PASS).
CCCCC SUBROUTINE DPBABA(IHARG,IARGT,ARG,NUMARG,ADEBBA,MAXBAR,ABARBA,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR BASES.
C              THESE ARE LOCATED IN THE VECTOR ABARBA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADEBBA
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ABARBA (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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  1983.
C     UPDATED         --OCTOBER   1993.  ADD BAR BASE AUTOMATIC Y
C                                            BAR BASE AUTO DISTINCT Y
C                                        THESE USEFUL FOR STACKED BARS
C     UPDATED         --NOVEMBER  1994. DECLARATION OF IBUGQ
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC OCTOBER 1993.  COMMENT OUT FOLLOWING 2 LINES
CCCCC CHARACTER*4 IHARG
CCCCC CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC OCTOBER 1993.  COMMNET OUT FOLLOWING 3 LINES
CCCCC DIMENSION IHARG(*)
CCCCC DIMENSION IARGT(*)
CCCCC DIMENSION ARG(*)
      DIMENSION ABARBA(*)
CCCCC OCTOBER 1993.  ADD FOLLOWING SECTION.
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IWRITE
CCCCC NOVEMBER 1994.  ADD FOLLOWING LINE.
      CHARACTER*4 IBUGQ
C
C
CCCCC OCTOBER 1993.  ADD FOLLOWING COMMON BLOCKS
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBA'
      ISUBN2='BA  '
C
      NUMBAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBABA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ADEBBA
   55 FORMAT('ADEBBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ABARBA(1)
   70 FORMAT('ABARBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ABARBA(I)
   76 FORMAT('I,ABARBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
CCCCC OCTOBER 1993.  ADD BAR BASE AUTOMATIC <VAR>
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'AUTO')GOTO3000
C
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=ADEBBA
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      ABARBA(1)=ADEBBA
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEBBA
      ABARBA(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,ABARBA(I)
 1276 FORMAT('THE BASE OF BAR ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEBBA
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEBBA
      DO1315I=1,NUMBAR
      ABARBA(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ABARBA(I)
 1316 FORMAT('THE BASE OF ALL BARS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               ******************************************************
C               **  STEP 30--                                       **
C               **  TREAT THE BAR BASE   AUTOMATIC <VARIABLE>   CASE**
C               ******************************************************
C
 3000 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2 (OR 3)**
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(3)
      IHLEF2=IHARG2(3)
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')IHLEFT=IHARG(4)
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')IHLEF2=IHARG2(4)
      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 32--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='32'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO3290
      DO3200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO3210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO3210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO3220
 3200 CONTINUE
      GOTO3290
 3210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO3290
 3220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO3290
 3290 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO3295
      WRITE(ICOUT,3291)NUMARG,ILOCQ
 3291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 3295 CONTINUE
C
C               *********************************************
C               **  STEP 33--                              **
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='33'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO3310
      IF(ICASEQ.EQ.'SUBS')GOTO3320
      IF(ICASEQ.EQ.'FOR')GOTO3330
C
 3310 CONTINUE
      DO3315I=1,NLEFT
      ISUB(I)=1
 3315 CONTINUE
      NQ=NLEFT
      GOTO3350
C
 3320 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3350
C
 3330 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3350
C
 3350 CONTINUE
      MINN2=1
      IF(NQ.GE.MINN2)GOTO3360
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3351)
 3351 FORMAT('***** ERROR IN DPBABA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3352)
 3352 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3353)IHLEFT,IHLEF2
 3353 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3354)
 3354 FORMAT('      (FOR WHICH BAR BASE DEFINITIONS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3355)
 3355 FORMAT('      ARE TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3356)MINN2
 3356 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3357)
 3357 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3358)
 3358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3359)(IANS(I),I=1,IWIDTH)
 3359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3360 CONTINUE
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3370I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3370
      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
 3370 CONTINUE
      NS=J
      NY=J
C
C               *****************************************
C               **  STEP 34--                          **
C               **  IF HAVE THE FORM--                 **
C               **  BAR BASE   AUTOMATIC DISTINCT X    **
C               **  EXTRACT THE DISTINCT VALUES        **
C               **  FROM THE TARGET VARIABLE Y(.)   .  **
C               **  STORE THEM IN X(.)   .             **
C               **  IF HAVE THE FORM--                 **
C               **  CHARACTERS AUTOMATIC X             **
C               **  DO NOTHING                         **
C               *****************************************
C
      IF(IHARG(3).EQ.'DIST'.AND.IHARG2(3).EQ.'INCT')GOTO3420
C
 3410 CONTINUE
      DO3411I=1,NY
      X(I)=Y(I)
 3411 CONTINUE
      NX=NY
      GOTO3490
C
 3420 CONTINUE
      IWRITE='OFF'
      CALL DISTIN(Y,NY,IWRITE,X,NX,IBUGP2,IERROR)
      GOTO3490
C
 3490 CONTINUE
C
C               ******************************************
C               **  STEP 36--                           **
C               **  COPY VALUES IN X(.) TO ABARBA       **
C               **        MAX NUMBER OF BARS    = 100   **
C               ******************************************
C
      IMAX=NX
      IF(IMAX.GT.MAXBAR)IMAX=MAXBAR
      DO3650I=1,IMAX
      ABARBA(I)=X(I)
 3650 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3679
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO3675I=1,IMAX
      WRITE(ICOUT,3676)I,ABARBA(I)
 3676 FORMAT('BAR BASE ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 3675 CONTINUE
 3679 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBABA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ADEBBA
 9015 FORMAT('ADEBBA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ABARBA(1)
 9030 FORMAT('ABARBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ABARBA(I)
 9036 FORMAT('I,ABARBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBACL(IHARG,NUMARG,IDEFBK,IBACCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE BACKGROUND
C              (THE REGION WITHIN THE FRAME LINES).
C              THE COLOR FOR THE BACKGROUND WILL BE PLACED
C              IN THE HOLLERITH VARIABLE IBACCO.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFBK
C     OUTPUT ARGUMENTS--IBACCO
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--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFBK
      CHARACTER*4 IBACCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO1150
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IBACCO=IDEFBK
      GOTO1180
C
 1160 CONTINUE
      IBACCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBACCO
 1181 FORMAT('THE BACKGROUND COLOR HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBACO(IHARG,NUMARG,IDEFBC,MAXBAR,IBARCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR COLORS.
C              THESE ARE LOCATED IN THE VECTOR IBARCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFBC
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBARCO (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFBC
      CHARACTER*4 IBARCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBARCO(*)
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
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBACO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEFBC
   55 FORMAT('IDEFBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBARCO(1)
   70 FORMAT('IBARCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBARCO(I)
   76 FORMAT('I,IBARCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IDEFBC
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBARCO(1)=IDEFBC
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFBC
      IBARCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBARCO(I)
 1276 FORMAT('BAR (LINE) COLOR ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFBC
      DO1315I=1,NUMBAR
      IBARCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBARCO(I)
 1316 FORMAT('ALL BAR (LINE) COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBACO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEFBC
 9015 FORMAT('IDEFBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBARCO(1)
 9030 FORMAT('IBARCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBARCO(I)
 9036 FORMAT('I,IBARCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBADI(IHARG,NUMARG,IDEBDI,MAXBAR,IBARDI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR DIRECTION--
C              VERT = VERTICAL
C              HORI = HORIZONTAL
C              HOR2 = HORIZONTAL TOWARD X2-X3 PLANE (FOR 3D PLOTS)
C              THESE ARE LOCATED IN THE VECTOR IBARDI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBDI
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBARDI (A CHARACTER VECTOR)
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--87/5
C     ORIGINAL VERSION--MAY       1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBDI
      CHARACTER*4 IBARDI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBARDI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBA'
      ISUBN2='DI  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBADI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBDI
   55 FORMAT('IDEBDI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBARDI(1)
   70 FORMAT('IBARDI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBARDI(I)
   76 FORMAT('I,IBARDI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='VERT'
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION   CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBARDI(1)='VERT'
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
C???? IF(IHOLD1.EQ.'VERT')IHOLD2='VERT'
C???? IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBDI
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBDI
      IBARDI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBARDI(I)
 1276 FORMAT('BAR DIRECTION ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
C???? IF(IHOLD1.EQ.'2')IHOLD2='2'
C???? IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBDI
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBDI
      DO1315I=1,NUMBAR
      IBARDI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBARDI(I)
 1316 FORMAT('ALL BAR DIRECTIONS',
     1'HAVE JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBADI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBDI
 9015 FORMAT('IDEBDI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBARDI(1)
 9030 FORMAT('IBARDI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBARDI(I)
 9036 FORMAT('I,IBARDI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBAEF(IHARG,IARGT,ARG,NUMARG,BARHEF,BARWEF,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE BAR EXPANSION FACTORS
C              FOR THE HEIGHT AND WIDTH OF BARS IN BLOCK PLOTS (ONLY)
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--BARHEF = BAR HEIGHT EXPANSION FACTOR
C                     --BARWEF = BAR WIDTH EXPANSION FACTOR
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 NATIONAL INSTITUTE OF STANDARDS & TECHNOLOGY
C                 GAITHERSBURG, MARYLAND 20899
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     ORIGINAL VERSION--APRIL     1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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
      ISUBN1='DPBA'
      ISUBN2='EF  '
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBAEF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)BARHEF,BARWEF
   70 FORMAT('BARHEF,BARWEF = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1)THEN
         IF(IHARG(NUMARG).EQ.'ON')GOTO1100
         IF(IHARG(NUMARG).EQ.'OFF')GOTO1100
         IF(IHARG(NUMARG).EQ.'AUTO')GOTO1100
         IF(IHARG(NUMARG).EQ.'DEFA')GOTO1100
      ENDIF
      GOTO1900
 1100 CONTINUE
      BARHEF=1.0
      BARWEF=1.0
      GOTO8000
 1900 CONTINUE
C
      IF(NUMARG.EQ.1)THEN
         BARHEF=1.0
         BARWEF=1.0
         GOTO8000
      ENDIF
C
      IF(NUMARG.GE.2)THEN
         IF(IARGT(NUMARG-1).EQ.'NUMB'.AND.IARGT(NUMARG).EQ.'NUMB')THEN
            BARHEF=ARG(NUMARG-1)
            BARWEF=ARG(NUMARG)
            GOTO8000
         ELSE
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1041)
 1041       FORMAT('***** ERROR IN DPBAEF--')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1042)
 1042       FORMAT('      THE LAST 2 ARGUMENTS OF THE ')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1043)
 1043       FORMAT('      BAR EXPANSION FACTORS     COMMAND')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1044)
 1044       FORMAT('      MUST BE NUMBERS.')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1045)
 1045       FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,1046)
 1046       FORMAT('      EXAMPLE--BAR EXPANSION FACTORS 1.1 0.8')
      CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
         ENDIF
      ENDIF
C
 8000 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO8090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8011)
 8011 FORMAT('THE BAR EXPANSION FACTORS (HEIGHT & WIDTH)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('(FOR BLOCK PLOTS ONLY)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)BARHEF,BARWEF
 8013 FORMAT('HAVE JUST BEEN SET TO ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 8090 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBAEF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)IHARG(I),IARGT(I),ARG(I)
 9031 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9041)BARHEF,BARWEF
 9041 FORMAT('BARHEF,BARWEF = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBAGP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ISEED,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A BAG PLOT
C              (A BIVARIATE EXTENSION OF THE BAG PLOT)2 DATA SETS).
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     REFERENCE--"The Bagplot: A Bivariate Boxplot", ROUSSEEUW, RUTS,
C                TUKEY, THE AMERICAN STATISTICIAN, November, 1999,
C                PP. 382-387.  USES FORTRAN ROUTINE DOWNLOADED
C                FROM ROUSSEEUW WEB SITE.
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/3
C     ORIGINAL VERSION--MARCH     2001.
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 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      PARAMETER (MAXOB2=MAXOBV/2)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION XD(MAXOBV)
      DIMENSION YD(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZI.INC'
      INTEGER ITMP1(MAXOBV)
      INTEGER ITMP2(MAXOBV)
      INTEGER ITMP3(MAXOBV)
      INTEGER ITMP4(MAXOBV)
      INTEGER ITMP5(MAXOBV)
      INTEGER ITMP6(MAXOBV)
      INTEGER ITMP7(MAXOBV)
      INTEGER ITMP8(MAXOBV)
      INTEGER ITMP9(MAXOBV)
      INTEGER ITMP10(MAXOBV)
      INTEGER ITMP11(MAXOBV)
      INTEGER ITMP12(MAXOB2)
      INTEGER ITMP13(MAXOB2)
      INTEGER ITMP14(MAXOB2)
      INTEGER ITMP15(MAXOB2)
      INTEGER ITMP16(MAXOB2)
      INTEGER ITMP17(MAXOB2)
      INTEGER ITMP18(MAXOB2)
      INTEGER ITMP19(MAXOB2)
      INTEGER ITMP20(MAXOB2)
      INTEGER ITMP21(MAXOB2)
C
CCCCC DOUBLE PRECISION DTMP1(MAXOBV)
CCCCC DOUBLE PRECISION DTMP2(MAXOBV)
CCCCC DOUBLE PRECISION DTMP3(MAXOBV)
CCCCC DOUBLE PRECISION DTMP4(MAXOBV)
CCCCC DOUBLE PRECISION DTMP5(MAXOBV)
CCCCC DOUBLE PRECISION DTMP6(MAXOBV)
CCCCC DOUBLE PRECISION DTMP7(MAXOBV)
CCCCC DOUBLE PRECISION DTMP8(MAXOBV)
CCCCC DOUBLE PRECISION DTMP9(MAXOBV)
CCCCC DOUBLE PRECISION DTMP10(MAXOBV)
CCCCC DOUBLE PRECISION DTMP11(MAXOBV)
CCCCC DOUBLE PRECISION DTMP12(MAXOBV)
CCCCC DOUBLE PRECISION DTMP13(MAXOBV)
CCCCC DOUBLE PRECISION DTMP14(MAXOBV)
C
CCCCC DOUBLE PRECISION DTMP15(MAXOB2)
CCCCC DOUBLE PRECISION DTMP16(MAXOB2)
CCCCC DOUBLE PRECISION DTMP17(MAXOB2)
CCCCC DOUBLE PRECISION DTMP18(MAXOB2)
CCCCC DOUBLE PRECISION DTMP19(MAXOB2)
CCCCC DOUBLE PRECISION DTMP20(MAXOB2)
CCCCC DOUBLE PRECISION DTMP21(MAXOB2)
CCCCC DOUBLE PRECISION DTMP22(MAXOB2)
CCCCC DOUBLE PRECISION DTMP23(MAXOB2)
CCCCC DOUBLE PRECISION DTMP24(MAXOB2)
CCCCC DOUBLE PRECISION DTMP25(MAXOB2)
CCCCC DOUBLE PRECISION DTMP26(MAXOB2)
CCCCC DOUBLE PRECISION DTMP27(MAXOB2)
CCCCC DOUBLE PRECISION DTMP28(MAXOB2)
CCCCC DOUBLE PRECISION DTMP29(MAXOB2)
CCCCC DOUBLE PRECISION DTMP30(MAXOB2)
CCCCC DOUBLE PRECISION DTMP31(MAXOB2)
CCCCC DOUBLE PRECISION DTMP32(MAXOB2)
CCCCC DOUBLE PRECISION DTMP33(MAXOB2)
CCCCC DOUBLE PRECISION DTMP34(MAXOB2)
CCCCC DOUBLE PRECISION DTMP35(MAXOB2)
CCCCC DOUBLE PRECISION DTMP36(MAXOB2)
CCCCC DOUBLE PRECISION DTMP37(MAXOB2)
CCCCC DOUBLE PRECISION DTMP38(MAXOB2)
CCCCC DOUBLE PRECISION DTMP39(MAXOB2)
CCCCC DOUBLE PRECISION DTMP40(MAXOB2)
CCCCC DOUBLE PRECISION DTMP41(MAXOB2)
CCCCC DOUBLE PRECISION DTMP42(MAXOB2)
CCCCC DOUBLE PRECISION DTMP43(MAXOB2)
CCCCC DOUBLE PRECISION DTMP44(MAXOB2)
CCCCC DOUBLE PRECISION DTMP45(MAXOB2)
CCCCC EQUIVALENCE (IGARBG(IIGAR1),ITMP1(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR2),ITMP2(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR3),ITMP3(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR4),ITMP4(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR5),ITMP5(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR6),ITMP6(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR7),ITMP7(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR8),ITMP8(1))
CCCCC EQUIVALENCE (IGARBG(IIGAR9),ITMP9(1))
CCCCC EQUIVALENCE (IGARBG(IIGR10),ITMP10(1))
CCCCC EQUIVALENCE (IGARBG(IIGR11),ITMP11(1))
CCCCC EQUIVALENCE (IGARBG(IIGR12),ITMP12(1))
CCCCC EQUIVALENCE (IGARBG(IIGR12+MAXOB2+1),ITMP13(1))
CCCCC EQUIVALENCE (IGARBG(IIGR13),ITMP14(1))
CCCCC EQUIVALENCE (IGARBG(IIGR13+MAXOB2+1),ITMP15(1))
CCCCC EQUIVALENCE (IGARBG(IIGR14),ITMP16(1))
CCCCC EQUIVALENCE (IGARBG(IIGR14+MAXOB2+1),ITMP17(1))
CCCCC EQUIVALENCE (IGARBG(IIGR15),ITMP18(1))
CCCCC EQUIVALENCE (IGARBG(IIGR15+MAXOB2+1),ITMP19(1))
CCCCC EQUIVALENCE (IGARBG(IIGR16),ITMP20(1))
CCCCC EQUIVALENCE (IGARBG(IIGR16+MAXOB2+1),ITMP21(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR1),DTMP1(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR2),DTMP2(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR3),DTMP3(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR4),DTMP4(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR5),DTMP5(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR6),DTMP6(1))
CCCCC EQUIVALENCE (DGARBG(IDGAR7),DTMP7(1))
CCCCC EQUIVALENCE (GARBAG(IGARB1),DTMP8(1))
CCCCC EQUIVALENCE (GARBAG(IGARB3),DTMP9(1))
CCCCC EQUIVALENCE (GARBAG(IGARB5),DTMP10(1))
CCCCC EQUIVALENCE (GARBAG(IGARB7),DTMP11(1))
CCCCC EQUIVALENCE (GARBAG(IGARB9),DTMP12(1))
CCCCC EQUIVALENCE (GARBAG(JGAR11),DTMP13(1))
CCCCC EQUIVALENCE (GARBAG(JGAR13),DTMP14(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR11),DTMP15(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR12),DTMP16(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR13),DTMP17(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR14),DTMP18(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR15),DTMP19(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR16),DTMP20(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR17),DTMP21(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR18),DTMP22(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR19),DTMP23(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR20),DTMP24(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR21),DTMP25(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR22),DTMP26(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR23),DTMP27(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR24),DTMP28(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR25),DTMP29(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR26),DTMP30(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR27),DTMP31(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR28),DTMP32(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR29),DTMP33(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR30),DTMP34(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR31),DTMP35(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR32),DTMP36(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR33),DTMP37(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR34),DTMP38(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR35),DTMP39(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR36),DTMP40(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR37),DTMP41(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR38),DTMP42(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR39),DTMP43(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR40),DTMP44(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR41),DTMP45(1))
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
      ISUBN1='DPBA'
      ISUBN2='GP  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=6
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BAGP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      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)ISEED,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('ISEED,IBUGG2,IBUGG3,IBUGQ = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  TREAT THE BAG      PLOT CASE **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BAG '.AND.
     1   IHARG(2).EQ.'PLOT')GOTO1112
      GOTO9000
C
 1112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='BAGP'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     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 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BAGP')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A BAG PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,MIN(IWIDTH,80))
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ******************************************************
C               **  STEP 15--                                        *
C               **  EXAMINE THE VARIABLES--                          *
C               **  HAS EACH VARIABLE                                *
C               **  ALREADY BEEN DEFINED?                            *
C               **  NOTE THAT     ILISR1, ILISR2,                    *
C               **  IS THE LINE IN THE TABLE                         *
C               **  OF THE FIRST, SECOND  VARIABLE                   *
C               **  RESPECTIVELY.                                    *
C               **  NOTE THAT     ICOLR1, ICOLR2,                    *
C               **  IS THE DATA COLUMN (1 TO 10+6)                   *
C               **  OF THE FIRST, SECOND  VARIABLE RESPECTIVELY.     *
C               ******************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,MIN(80,IWIDTH))
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,MIN(80,IWIDTH))
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1580 CONTINUE
      IF(NIRIG1.EQ.NIRIG2)GOTO1590
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)
 1582 FORMAT('      THE BAG PLOT COMMAND REQUIRES BOTH VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1583)
 1583 FORMAT('      HAVE THE SAME NUMBER OF OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1584)IHRI11,IHRI12,NIRIG1
 1584 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1586)IHRI21,IHRI22,NIRIG2
 1586 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1588)
 1588 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1589)(IANS(I),I=1,MIN(80,IWIDTH))
 1589 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1590 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
      IF(NIRIG2.GT.NIRIG1)NLOCAL=NIRIG2
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH A QUANTILE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,MIN(80,IWIDTH))
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE VERTICAL AXIS VARIABLE         **
C               **       THE HORIZONTAL AXIS VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3310I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3310
      J=J+1
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
 3310 CONTINUE
      NS1=J
C
      J=0
      IMAX=NIRIG2
      IF(NQ.LT.NIRIG2)IMAX=NQ
      DO3320I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3320
      J=J+1
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
 3320 CONTINUE
      NS2=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  6 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NS1.LE.MINN2.OR.NS2.LE.MINN2)GOTO3450
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPBAGP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A BAG PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,MIN(80,IWIDTH))
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ******************************************************
C               **  STEP 41--                                        *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE  *
C               **  PLOT.  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='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BAGP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS=NS1
      IF(NS2.GT.NS1)NS=NS2
CCCCC CALL DPBAG2(Y1,NS1,Y2,NS2,ICASPL,MAXN,
CCCCC1Y,X,D,NPLOTP,NPLOTV,
CCCCC1ITMP1,ITMP2,ITMP3,ITMP4,ITMP5,ITMP6,ITMP7,ITMP8,
CCCCC1ITMP9,ITMP10,ITMP11,ITMP12,ITMP13,ITMP14,ITMP15,ITMP16,
CCCCC1ITMP17,ITMP18,ITMP19,ITMP20,ITMP21,
CCCCC1DTMP1,DTMP2,DTMP3,DTMP4,DTMP5,DTMP6,DTMP7,DTMP8,
CCCCC1DTMP9,DTMP10,DTMP11,DTMP12,DTMP13,DTMP14,DTMP15,DTMP16,
CCCCC1DTMP17,DTMP18,DTMP19,DTMP20,DTMP21,DTMP22,DTMP23,
CCCCC1DTMP24,DTMP25,DTMP26,DTMP27,DTMP28,DTMP29,DTMP30,
CCCCC1DTMP31,DTMP32,DTMP33,DTMP34,DTMP35,DTMP36,DTMP37,
CCCCC1DTMP38,DTMP39,DTMP40,DTMP41,DTMP42,DTMP43,DTMP44,
CCCCC1DTMP45,
CCCCC1IBUGG3,ISUBRO,IERROR)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BAGP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBAGP--')
      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)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      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
 9029 CONTINUE
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)NS1,NS2,NS
 9053 FORMAT('NS1,NS2,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBAR2(Y,X,N,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A QUADRUPLE OF COORDINATE VECTORS
C              THAT WILL DEFINE AN BAR PLOT.
C              IF ONLY 1 Y VALUE EXISTS FOR EACH X VALUE,
C              THEN A HISTOGRAM WILL RESULT (THE BAR WILL
C              REST ON 0);
C              IF MORE THAN 1 Y VALUE EXISTS FOR EACH X VALUE,
C              THEN THE BARS WILL BE SUSPENDED BETWEEN THE
C              MINIMUM AND MAXIMUM AT EACH X VALUE.
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     UPDATED         --JANUARY   1989.   CLASS WIDTH, 0 FREQ BARS (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOSU.INC'
      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
      ISUBN1='DPBA'
      ISUBN2='R2  '
C
      K=(-999)
      KP1=(-999)
C
      I2=0
      AN=0.0
C
      AN3=0
      DENOM=0.0
      CLWID=0.0
      XSTART=0.0
      XSTOP=0.0
      KP4=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 DPBAR2--')
      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 DPBAR2--')
      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=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 DPBAR2--')
      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(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPBAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMV2,ISIZE,ICONT
   71 FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT = ',I8,2X,A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),X(I)
   73 FORMAT('I, Y(I), X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
CCCCC WRITE(ICOUT,74)BAWID
CCC74 FORMAT('BAWID = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR VARIABLE 2 (THE GROUP VARIABLE).              **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH MEANS THAT A HISTOGRAM SHOULD RESULT        **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO110
      IF(NUMV2.EQ.2)GOTO150
C
  110 CONTINUE
      NUMSET=0
      DO120I=ISIZE,N,ISIZE
      I2=I
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  120 CONTINUE
      IF(I2.LT.N)GOTO130
      GOTO140
  130 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  140 CONTINUE
      DO145I=1,N
      IGROUP=1+((I-1)/ISIZE)
      IMID=(IGROUP-1)*ISIZE+(ISIZE/2)
      X(I)=IMID
  145 CONTINUE
      GOTO190
C
  150 CONTINUE
      NUMSET=0
      DO160I=1,N
      IF(NUMSET.EQ.0)GOTO165
      DO170J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO160
  170 CONTINUE
  165 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  160 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      XID1=XIDTEM(1)
      XID2=XIDTEM(NUMSET)
C
  190 CONTINUE
C
      IF(NUMSET.EQ.0)WRITE(ICOUT,191)
  191 FORMAT('ERROR IN DPBAR2   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.0)IERROR='YES'
C
      IF(NUMSET.EQ.N)GOTO1000
      GOTO2000
C
C               ********************************
C               **  STEP 4--                  **
C               **  TREAT THE HISTOGRAM CASE  **
C               ********************************
C
 1000 CONTINUE
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      KP3=0
C
      AN3=0.0
      DENOM=0.0
C
C               **********************************************
C               **  STEP 4.1--                               **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
      CALL SORT(X,N,D2)
      NM1=N-1
C  BUG FIX: (AUGUST, 1987) USE CLASS WIDTH PARAMETER IF SPECIFIED
      CLWID=CLWIDT(1)
      IF(CLWID.GT.0.0)GOTO1105
C  END FIX
      CLWID=D2(2)-D2(1)
      DO1100I=1,NM1
      IP1=I+1
      DELI=D2(IP1)-D2(I)
      IF(DELI.LT.CLWID)CLWID=DELI
 1100 CONTINUE
C  BUG FIX CONTINUED
 1105 CONTINUE
C  END FIX
      XSTART=D2(1)-(CLWID/2.0)
      XSTOP=D2(N)+(CLWID/2.0)
C
      TOTWID=XSTOP-XSTART
      ANUMCL=TOTWID/CLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      ABSDEL=ABS(CLMAXJ-XSTOP)
      IF(ABSDEL.LE.0.0001)NUMCLA=NUMCLA-1
C
C               *******************************************************
C               **  STEP 4.2--                                       **
C               **  DETERMINE THE FREQUENCY (COUNTS) FOR EACH CLASS  **
C               *******************************************************
C
      DO1300J=1,NUMCLA
      D2(J)=0.0
 1300 CONTINUE
C
 1510 CONTINUE
      DO1520I=1,N
      DO1530J=1,NUMCLA
      J2=J
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(CLMINJ.LE.X(I).AND.X(I).LT.CLMAXJ)GOTO1540
 1530 CONTINUE
      GOTO1520
 1540 CONTINUE
      D2(J2)=D2(J2)+Y(I)
 1520 CONTINUE
C
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C     (ALTHOUGH THIS SHOULD NOT HAPPEN)
C
      J=NUMCLA
      DO1550I=1,N
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(X(I).EQ.CLMAXJ)D2(J)=D2(J)+Y(I)
 1550 CONTINUE
      GOTO1590
C
 1590 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO1595
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1591)
 1591 FORMAT('***** IN THE MIDDLE    OF DPBAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1592)CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA
 1592 FORMAT('CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA= ',5E11.4,I8)
      CALL DPWRST('XXX','BUG ')
      DO1593J=1,NUMCLA
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      WRITE(ICOUT,1594)J,CLMINJ,CLMAXJ,FJ
 1594 FORMAT('J,CLMINJ,CLMAXJ,FJ = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 1593 CONTINUE
 1595 CONTINUE
C
C               **********************************
C               **  STEP 4.3--                  **
C               **  DETERMINE PLOT COORDINATES  **
C               **********************************
C
CCCCC IF(BAWID.EQ.CPUMIN)BAWID=CLWID
C
 1600 CONTINUE
      SUM=0.0
      DO1610J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1610 CONTINUE
      AN3=SUM
C
      DENOM=1.0
C  BUG FIX: AUGUST, 1987 DO NOT PLOT ZERO FREQUENCY BARS
      K=0
C  END BUG FIX
C
      DO1620J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
C  BUG FIX CONTINUED
CCCCC K=J
C  END BUG FIX
C
CCCCC AJ=J
CCCCC CLMIDJ=XSTART+(AJ-0.5)*CLWID
CCCCC BAMINJ=CLMIDJ-BAWID/2.0
CCCCC BAMAXJ=CLMIDJ+BAWID/2.0
      AJ=J
      CLMIDJ=XSTART+(AJ-0.5)*CLWID
C
      FJ=D2(J)
C  BUG FIX CONTINUED
      IF(ABS(FJ).LE.CPUMIN)GOTO1620
      K=K+1
C  END FIX
C
CCCCC X2(K)=BAMINJ
CCCCC X2(KP1)=BAMINJ
CCCCC X2(KP2)=BAMAXJ
CCCCC X2(KP3)=BAMAXJ
      X2(K)=CLMIDJ
C
CCCCC Y2(K)=0.0
CCCCC Y2(KP1)=FJ/DENOM
CCCCC Y2(KP2)=FJ/DENOM
CCCCC Y2(KP3)=0.0
      Y2(K)=FJ/DENOM
C
 1620 CONTINUE
C
C  BUG FIX CONTINUED
       NUMCLA=K
C  END FIX
      DO1720J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC D2(K)=J
CCCCC D2(KP1)=J
CCCCC D2(KP2)=J
CCCCC D2(KP3)=J
      D2(K)=J
C
 1720 CONTINUE
CCCCC N2=KP3
      N2=K
      NPLOTV=3
      GOTO9000
C
C               *****************************************************
C               **  STEP 14--                                       **
C               **  TREAT THE SUSPENDED BAR CASE.                  **
C               **  STEP THROUGH THE VARIOUS HORIZONTAL AXIS SETS  **
C               **  AND COMPUTE BAR COORDINATES FOR EACH SET.      **
C               *****************************************************
C
 2000 CONTINUE
C
      ISTEPN='14'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSM1=NUMSET-1
C  CONTINUE BUG FIX
      CLWID=CLWIDT(1)
      IF(CLWID.GT.0.)GOTO2060
C  END FIX
      CLWID=XIDTEM(2)-XIDTEM(1)
      DO2050I=1,NUMSM1
      IP1=I+1
      DELI=XIDTEM(IP1)-XIDTEM(I)
      IF(DELI.LT.CLWID)CLWID=DELI
 2050 CONTINUE
C  CONTINUE BUG FIX
 2060 CONTINUE
C  END FIX
CCCCC IF(BAWID.EQ.CPUMIN)BAWID=CLWID
C
      AN=N
      ANUMSE=NUMSET
C
      J=0
      JD=0
      DO2100ISET=1,NUMSET
C
      K=0
      DO2120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 2120 CONTINUE
      NI=K
      ANI=NI
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,2121)ISET,XIDTEM(ISET),NI
 2121 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NI.LE.0)GOTO2140
      GOTO2149
C
 2140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2141)
 2141 FORMAT('***** INTERNAL ERROR IN DPBAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2142)
 2142 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2143)ISET,XIDTEM(ISET),NI
 2143 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2149 CONTINUE
C
      CALL SORT(TEMP,NI,TEMP)
      YMIN=TEMP(1)
      YMAX=TEMP(NI)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,2151)YMIN,YMAX,ISET,K,TEMP(K)
 2151 FORMAT('YMIN,YMAX,ISET,K,TEMP(K) = ',2E15.7,2I8,E15.7)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      J=ISET
C
CCCCC K=5*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
CCCCC KP4=K+4
      K=2*(J-1)+1
      KP1=K+1
C
CCCCC CLMIDJ=XIDTEM(ISET)
CCCCC BAMINJ=CLMIDJ-BAWID/2.0
CCCCC BAMAXJ=CLMIDJ+BAWID/2.0
      CLMIDJ=XIDTEM(ISET)
C
CCCCC X2(K)=BAMINJ
CCCCC X2(KP1)=BAMINJ
CCCCC X2(KP2)=BAMAXJ
CCCCC X2(KP3)=BAMAXJ
CCCCC X2(KP4)=BAMINJ
      X2(K)=CLMIDJ
      X2(KP1)=CLMIDJ
C
CCCCC Y2(K)=YMIN
CCCCC Y2(KP1)=YMAX
CCCCC Y2(KP2)=YMAX
CCCCC Y2(KP3)=YMIN
CCCCC Y2(KP4)=YMIN
      Y2(K)=YMIN
      Y2(KP1)=YMAX
C
CCCCC D2(K)=J
CCCCC D2(KP1)=J
CCCCC D2(KP2)=J
CCCCC D2(KP3)=J
CCCCC D2(KP4)=J
      D2(K)=J
      D2(KP1)=J
C
 2620 CONTINUE
C
 2100 CONTINUE
CCCCC N2=KP4
      N2=KP1
      NPLOTV=3
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)AN,NI
 9014 FORMAT('AN,NI = ',E15.7,I8)
      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
      WRITE(ICOUT,9032)IERROR,N2
 9032 FORMAT('IERROR,N2 = ',A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)AN3,DENOM
 9033 FORMAT('AN3,DENOM = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)N,CLWID,XSTART,XSTOP
 9037 FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,NUMSET
      WRITE(ICOUT,9051)I,XIDTEM(I)
 9051 FORMAT('I,XIDTEM(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBARP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A BAR PLOT = A BAR CHART =
C              A HISTOGRAM
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     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
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 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATA
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
      CHARACTER*4 ICONT
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
CCCCC DIMENSION BAWIDT(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(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='DPBA'
      ISUBN2='RP  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
C
      MAXV2=2
      MINN2=2
C
      ICOLR=0
C
C               *******************************
C               **  TREAT THE BAR PLOT CASE  **
C               *******************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBARP--')
      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 ')
CCCCC WRITE(ICOUT,54)BAWIDT(1),BAWIDT(2)
CCC54 FORMAT('BAWIDT(1),BAWIDT(2) = ',2E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO110
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='BARP'
      IRELAT='OFF'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL 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 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.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(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.                   **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPBARP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A HISTOGRAM ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A RELATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'HIST'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A CUMULATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A RELATIVE CUMULATIVE HISTOGRAM ')
      IF(ICASPL.EQ.'CUMH'.AND.IRELAT.EQ.'ON')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
  390 CONTINUE
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(IBUGG2.EQ.'ON')CALL 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 DPBARP')
      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')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 5--                                        **
C               **  IF A SECOND ARGUMENT EXISTS (AS IT SHOULD), 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='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATA='FREQ'
      IF(NUMV2.EQ.2)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPBARP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A BAR 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 EXACTLY 2  ;')
      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
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPBARP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A BAR PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (FREQUENCIES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
  584 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
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 FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,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
C
      IF(NUMV2.LE.1)GOTO651
      GOTO652
C
  651 CONTINUE
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)X1(J)=RES(I)
      GOTO660
C
  652 CONTINUE
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
      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)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               *****************************************************
C               **  STEP 8--                                       **
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
CCCCC BAWID=BAWIDT(1)
C
      NUMV2=2
      ISIZE=1
      ICONT='ON'
      CALL DPBAR2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1XIDTEM,TEMP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
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 DPBARP--')
      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 ')
CCCCC WRITE(ICOUT,9014)BAWIDT(1),BAWIDT(2)
C9014 FORMAT('BAWIDT(1),BAWIDT(2) = ',2E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9015)BAWID
C9015 FORMAT('BAWDI = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBASW(IHARG,NUMARG,IDEBSW,MAXBAR,IBARSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR SWITCHES.
C              THESE ARE LOCATED IN THE VECTOR IBARSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBSW
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBARSW (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBSW
      CHARACTER*4 IBARSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBARSW(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBA'
      ISUBN2='SW  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBASW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBSW
   55 FORMAT('IDEBSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBARSW(1)
   70 FORMAT('IBARSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBARSW(I)
   76 FORMAT('I,IBARSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION   CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBARSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBSW
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBSW
      IBARSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBARSW(I)
 1276 FORMAT('BAR ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBSW
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBSW
      DO1315I=1,NUMBAR
      IBARSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBARSW(I)
 1316 FORMAT('ALL BARS ',
     1'HAVE JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBASW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBSW
 9015 FORMAT('IDEBSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBARSW(1)
 9030 FORMAT('IBARSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBARSW(I)
 9036 FORMAT('I,IBARSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBATY(IHARG,NUMARG,IDEBTY,MAXBAR,IBARTY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR DIMENSION (2 OR 3)
C              THESE ARE LOCATED IN THE VECTOR IBARTY(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBTY
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBARTY (A CHARACTER VECTOR)
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--87/5
C     ORIGINAL VERSION--APRIL     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBTY
      CHARACTER*4 IBARTY
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBARTY(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBA'
      ISUBN2='TY  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBATY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBTY
   55 FORMAT('IDEBTY = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBARTY(1)
   70 FORMAT('IBARTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBARTY(I)
   76 FORMAT('I,IBARTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='2'
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION   CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBARTY(1)='2'
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'2')IHOLD2='2'
      IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBTY
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBTY
      IBARTY(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBARTY(I)
 1276 FORMAT('BAR DIMENSION ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'2')IHOLD2='2'
      IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBTY
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBTY
      DO1315I=1,NUMBAR
      IBARTY(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBARTY(I)
 1316 FORMAT('ALL BAR DIMENSIONS',
     1'HAVE JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBATY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBTY
 9015 FORMAT('IDEBTY = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBARTY(1)
 9030 FORMAT('IBARTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBARTY(I)
 9036 FORMAT('I,IBARTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBAUD(IHARG,IARGT,IARG,NUMARG,IDEFBA,
     1IBAUD,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAUD RATE AT WHICH THE TERMINAL
C              IS TRANSMITTING TO THE HOST.
C              THE SPECIFIED BAUD RATE VALUE WILL BE PLACED
C              IN THE INTEGER VARIABLE IBAUD.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFBA (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IBAUD  (AN INTEGER 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 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 IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPBAUD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR BAUD RATE ',
     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 THE THE TERMINAL IS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      TRANSMITTING AT 9600 BAUD, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      BAUD RATE 9600 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      IHOLD=IDEFBA
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBAUD=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBAUD
 1181 FORMAT('THE BAUD RATE HAS JUST BEEN SET TO ',
     1I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)IBAUD
 8111 FORMAT('THE CURRENT BAUD RATE IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFBA
 8112 FORMAT('THE DEFAULT BAUD RATE IS ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPBAWI(IHARG,IARGT,ARG,NUMARG,ADEBWI,MAXBAR,ABARWI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR WIDTHS.
C              THESE ARE LOCATED IN THE VECTOR ABARWI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADEBWI
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ABARWI (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION ABARWI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBA'
      ISUBN2='WI  '
C
      NUMBAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBAWI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ADEBWI
   55 FORMAT('ADEBWI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ABARWI(1)
   70 FORMAT('ABARWI(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ABARWI(I)
   76 FORMAT('I,ABARWI(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=ADEBWI
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      ABARWI(1)=ADEBWI
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-1
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEBWI
      ABARWI(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,ABARWI(I)
 1276 FORMAT('THE WIDTH OF BAR ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEBWI
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEBWI
      DO1315I=1,NUMBAR
      ABARWI(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ABARWI(I)
 1316 FORMAT('THE WIDTH OF ALL BARS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBAWI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ADEBWI
 9015 FORMAT('ADEBWI = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ABARWI(1)
 9030 FORMAT('ABARWI(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ABARWI(I)
 9036 FORMAT('I,ABARWI(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBBCO(IHARG,NUMARG,IDEBBC,MAXBAR,IBABCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR BORDER COLORS = THE COLORS
C              OF THE BORDER LINE AROUND THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBABCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBBC
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBABCO (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBBC
      CHARACTER*4 IBABCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBABCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBB'
      ISUBN2='CO  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBBC
   55 FORMAT('IDEBBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBABCO(1)
   70 FORMAT('IBABCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBABCO(I)
   76 FORMAT('I,IBABCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBABCO(1)=IDEBBC
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBBC
      IBABCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBABCO(I)
 1276 FORMAT('THE COLOR OF BAR BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBBC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBBC
      DO1315I=1,NUMBAR
      IBABCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBABCO(I)
 1316 FORMAT('THE COLOR OF ALL BAR BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBBCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBBC
 9015 FORMAT('IDEBBC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBABCO(1)
 9030 FORMAT('IBABCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBABCO(I)
 9036 FORMAT('I,IBABCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBBLI(IHARG,IHARG2,NUMARG,IDEBBL,MAXBAR,IBABLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPBBLI(IHARG,NUMARG,IDEBBL,MAXBAR,IBABLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BORDER LINES = THE LINES TYPES
C              OF THE BORDER AROUND THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBABLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBBL
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBABLI (A CHARACTER VECTOR)
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  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEBBL
      CHARACTER*4 IBABLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IBABLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBB'
      ISUBN2='LI  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBBL
   55 FORMAT('IDEBBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBABLI(1)
   70 FORMAT('IBABLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBABLI(I)
   76 FORMAT('I,IBABLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBABLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-3
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBBL
      IBABLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBABLI(I)
 1276 FORMAT('THE LINE TYPE FOR BAR BORDER ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBBL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBBL
      DO1315I=1,NUMBAR
      IBABLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBABLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL BAR BORDERS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBBLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBBL
 9015 FORMAT('IDEBBL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBABLI(1)
 9030 FORMAT('IBABLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBABLI(I)
 9036 FORMAT('I,IBABLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBBTH(IHARG,IARGT,ARG,NUMARG,PDEBBT,MAXBAR,PBABTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR (BORDER) LINE THICKNESSES = THE THICKNESSES
C              OF THE BORDER LINE AROUND THE BARS.
C              THESE ARE LOCATED IN THE VECTOR PBABTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEBBT
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PBABTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PBABTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBB'
      ISUBN2='TH  '
C
      NUMBAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEBBT
   55 FORMAT('PDEBBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PBABTH(1)
   70 FORMAT('PBABTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PBABTH(I)
   76 FORMAT('I,PBABTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEBBT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      PBABTH(1)=PDEBBT
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBBT
      PBABTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,PBABTH(I)
 1276 FORMAT('THE THICKNESS OF BAR BORDER ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBBT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBBT
      DO1315I=1,NUMBAR
      PBABTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PBABTH(I)
 1316 FORMAT('THE THICKNESS OF ALL BAR BORDERS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBBTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEBBT
 9015 FORMAT('PDEBBT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PBABTH(1)
 9030 FORMAT('PBABTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PBABTH(I)
 9036 FORMAT('I,PBABTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBCCP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A BOX-COX CORRELATION PLOT
C              (USEFUL FOR DETERMINING THAT TRANSFORMATION
C              IN X WHICH MAXIMIZES THE CORRELATION BETWEEN
C              Y AND TRANSFORMED 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--87/6
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --MAY       1994. AUTO-COMPUTE MAXCC & BEST LAMBDA
C     UPDATED         --JULY      1995. CHARACTER*4 IWRITE
C     UPDATED         --JULY      1995. COMMON IHOST1 FOR IHOST1
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 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IERRO2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
CCCCC SEPTEMBER 1995.  ADD FOLLOWING LINE.
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN0
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
C
C---------------------------------------------------------------------
C
CCCCC SEPTEMBER 1995.  ADD FOLLOWING LINE.
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION XD(MAXOBV)
      DIMENSION YD(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
      EQUIVALENCE (GARBAG(IGARB5),XD(1))
      EQUIVALENCE (GARBAG(IGARB6),YD(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
      ISUBN1='DPBC'
      ISUBN2='CP  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BCCP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      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)IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************************
C               **  TREAT THE BOX-COX CORRELATION PLOT CASE **
C               **********************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PLOT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='BCCP'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     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 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BCCP')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A BOX-COX CORRELATION PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN BOX-COX CORRELATION PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE INDEPENDENT VARIABLE           **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  2 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUN1=0
      ICOUN2=0
      IF(NS.LE.2)ICOUN1=NS
      IF(NS.LE.2)ICOUN2=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
      IF(Y1(I).LE.-0.0001.OR.Y1(I).GE.0.0001)ICOUN1=ICOUN1+1
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUN2=ICOUN2+1
 3400 CONTINUE
 3410 CONTINUE
      IF(ICOUN1.LE.MINN2)GOTO3450
      IF(ICOUN2.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPBCCP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A BOX-COX CORRELATION PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)ICOUN1,ICOUN2
 3459 FORMAT('(ICOUN1, ICOUN2 = ',2I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,IWIDTH)
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED LIMITS                     **
C               **  FOR THE LAMBDA PARAMETER VALUES          **
C               **  (THIS WILL DICTATE WHAT WILL APPEAR      **
C               **  ON THE HORIZONTAL AXIS OF THE            **
C               **  OF THE BOX-COX CORRELATION PLOT)         **
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB1=-2.0
      IF(IERRO2.EQ.'NO')ALAMB1=VALUE(ILOCP)
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB2=2.0
      IF(IERRO2.EQ.'NO')ALAMB2=VALUE(ILOCP)
C
C               ****************************************************************
C               **  STEP 51--                                                  *
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='51'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCCP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPBCC2(Y1,Y2,NS,ICASPL,MAXN,
     1ALAMB1,ALAMB2,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
CCCCC THE FOLLOWING ENTIRE SECTION WAS ADDED                MAY 1994
CCCCC TO PROVIDE MAX-CC AND THE CORRESPONDING BEST LAMBDA   MAY 1994
C               ******************************************
C               **  STEP 61--                           **
C               **  COMMPUTE CORR. CO & BEST LAMBDA     **
C               **  UPDATE INTERNAL DATAPLOT TABLES     **
C               ******************************************
C
      ISTEPN='61'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL MAXIM(Y,NPLOTP,IWRITE,YMAX,IBUGG3,IERROR)
      DO6000I=1,NPLOTP
      I2=I
      IF(Y(I).EQ.YMAX)GOTO6009
 6000 CONTINUE
 6009 CONTINUE
      XBEST=X(I2)
C
      ISUBN0='BCCP'
C
      IH='MAXL'
      IH2='PCC '
      VALUE0=YMAX
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='LPLA'
      IH2='MBDA'
      VALUE0=XBEST
      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.'BCCP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBCCP--')
      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)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)YMAX,XBEST
 9017 FORMAT('YMAX,XBEST = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      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
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUN1,ICOUN2
 9031 FORMAT('ICOUN1,ICOUN2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)ALAMB1,ALAMB2
 9032 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBCC2(Y1,X1,N1,ICASPL,MAXN,
     1ALAMB1,ALAMB2,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              THE BOX-COX CORRELATION PLOT TRACE
C              WHICH IS A PLOT OF THE CORRELATION COEFFICIENT
C              OF THE CORRELATION COEFFICIENT (Y,T(X))
C              VERSUS THE BOX-COX PARAMATER LAMBDA.
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/6
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --DECEMBER  1993.  CHARACTER*4 ICASPL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION DISPAR(100)
      DIMENSION CORR(100)
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='DPBC'
      ISUBN2='C2  '
C
      IERROR='NO'
C
      AN1=0.0
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BCC2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,N1,NPLOTV
   53 FORMAT('ICASPL,MAXN,N1,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ALAMB1,ALAMB2
   54 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO62
      DO60I=1,N1
      WRITE(ICOUT,61)I,Y1(I),X1(I)
   61 FORMAT('I,Y1(I),X1(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   62 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPBCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N1
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPBCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=X1(1)
      DO1130I=1,N1
      IF(X1(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPBCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               *******************************************************
C               **  STEP 21--                                        **
C               **  DETERMINE THE SET OF PARAMETER VALUES            **
C               **  TO BE USED FOR THE TRANSFORMATIONS               **
C               *******************************************************
C
      NUMDIS=41
      ANUMDI=NUMDIS
      DO2100IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
 2100 CONTINUE
C
C               ****************************************
C               **  STEP 22--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      DO2210I=1,N1
      Y2(I)=Y1(I)
 2210 CONTINUE
C
      XMIN=X1(1)
      DO2220I=1,N1
      IF(X1(I).LT.XMIN)XMIN=X1(I)
 2220 CONTINUE
C
      DO2230I=1,N1
      D2(I)=X1(I)
 2230 CONTINUE
C
      IF(XMIN.GT.0.0)GOTO2249
      DO2240I=1,N1
      D2(I)=D2(I)-XMIN+1.0
 2240 CONTINUE
 2249 CONTINUE
C
      DO2300IDIS=1,NUMDIS
C
      ALAMBA=DISPAR(IDIS)
      IF(-0.001.LE.ALAMBA.AND.ALAMBA.LE.0.001)GOTO2310
      GOTO2320
 2310 CONTINUE
      DO2315I=1,N1
      X2(I)=ALOG(D2(I))
 2315 CONTINUE
      GOTO2329
 2320 CONTINUE
      DO2325I=1,N1
      X2(I)=((D2(I)**ALAMBA)-1.0)/ALAMBA
 2325 CONTINUE
      GOTO2329
 2329 CONTINUE
C
      AN1=N1
      SUMX=0.0
      SUMY=0.0
      DO2410I=1,N1
      SUMX=SUMX+X2(I)
      SUMY=SUMY+Y2(I)
 2410 CONTINUE
      XBAR=SUMX/AN1
      YBAR=SUMY/AN1
C
      SUMX=0.0
      SUMY=0.0
      SUMXY=0.0
      DO2420I=1,N1
      SUMX=SUMX+(X2(I)-XBAR)*(X2(I)-XBAR)
      SUMY=SUMY+(Y2(I)-YBAR)*(Y2(I)-YBAR)
      SUMXY=SUMXY+(X2(I)-XBAR)*(Y2(I)-YBAR)
 2420 CONTINUE
      ARG=SUMX*SUMY
      CC=0.0
      IF(ARG.GT.0.0)CC=SUMXY/SQRT(ARG)
      CORR(IDIS)=CC
C
      IF(IBUGG3.EQ.'OFF')GOTO2439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2431I=1,N1
      WRITE(ICOUT,2433)I,Y1(I),X1(I),Y2(I),X2(I),D2(I),CORR(I)
 2433 FORMAT('I,Y1(I),X1(I),Y2(I),X2(I),D2(I),CORR(I) = ',I8,6E12.5)
      CALL DPWRST('XXX','BUG ')
 2431 CONTINUE
      WRITE(ICOUT,2434)ICASPL,XBAR,YBAR,SUMX,SUMY,SUMXY
 2434 FORMAT('ICASPL,XBAR,YBAR,SUMX,SUMY,SUMXY = ',
     1A4,2X,5E15.7)
      CALL DPWRST('XXX','BUG ')
 2439 CONTINUE
C
 2300 CONTINUE
C
 2500 CONTINUE
      DO2510IDIS=1,NUMDIS
      Y2(IDIS)=CORR(IDIS)
      X2(IDIS)=DISPAR(IDIS)
      D2(IDIS)=1.0
 2510 CONTINUE
      N2=NUMDIS
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBCC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      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 DPBCHP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A BOX-COX HOMOSCEDASTICITY PLOT
C              (USEFUL FOR DETERMINING THAT TRANSFORMATION
C              IN X WHICH "MAXIMIZES THE HOMOSCEDASTICITY" BETWEEN
C              TRANSFORMED Y AND X).
C     NOTE--THE CRITERION FOR HOMOSCEDASTICITY IS THAT THE
C           CORR(WITHIN-SET SD, SET ID) BE 0
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/6
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
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 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IERRO2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION XD(MAXOBV)
      DIMENSION YD(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
      EQUIVALENCE (GARBAG(IGARB5),XD(1))
      EQUIVALENCE (GARBAG(IGARB6),YD(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
      ISUBN1='DPBC'
      ISUBN2='HP  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BCHP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      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)IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************************
C               **  TREAT THE BOX-COX HOMOSCEDASTICITY PLOT CASE **
C               **********************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PLOT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='BCHP'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     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 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BCHP')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A BOX-COX HOMOSCEDASTICITY PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN BOX-COX HOMOSCEDASTICITY PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE INDEPENDENT VARIABLE           **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  2 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUN1=0
      ICOUN2=0
      IF(NS.LE.2)ICOUN1=NS
      IF(NS.LE.2)ICOUN2=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
      IF(Y1(I).LE.-0.0001.OR.Y1(I).GE.0.0001)ICOUN1=ICOUN1+1
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUN2=ICOUN2+1
 3400 CONTINUE
 3410 CONTINUE
      IF(ICOUN1.LE.MINN2)GOTO3450
      IF(ICOUN2.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPBCHP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A BOX-COX HOMOSCEDASTICITY PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)ICOUN1,ICOUN2
 3459 FORMAT('(ICOUN1, ICOUN2 = ',2I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,IWIDTH)
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED LIMITS                     **
C               **  FOR THE LAMBDA PARAMETER VALUES          **
C               **  (THIS WILL DICTATE WHAT WILL APPEAR      **
C               **  ON THE HORIZONTAL AXIS OF THE            **
C               **  OF THE BOX-COX HOMOSCEDASTICITY PLOT)         **
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB1=-2.0
      IF(IERRO2.EQ.'NO')ALAMB1=VALUE(ILOCP)
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB2=2.0
      IF(IERRO2.EQ.'NO')ALAMB2=VALUE(ILOCP)
C
C               ****************************************************************
C               **  STEP 51--                                                  *
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='51'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'BCHP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPBCH2(Y1,Y2,NS,ICASPL,MAXN,
     1ALAMB1,ALAMB2,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'BCHP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBCHP--')
      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)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      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
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUN1,ICOUN2
 9031 FORMAT('ICOUN1,ICOUN2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)ALAMB1,ALAMB2
 9032 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBCH2(Y1,X1,N1,ICASPL,MAXN,
     1ALAMB1,ALAMB2,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              THE BOX-COX HOMOSCEDASTICITY PLOT TRACE
C              WHICH IS A PLOT
C              OF THE RATIO  MIN(SD(T(Y)) / MAX(SD(T(Y))
C              VERSUS THE BOX-COX PARAMATER LAMBDA.
C     NOTE--THE RATIO MUST BE BETWEEN 0 AND 1.
C           THE CLOSER TO 1, THE MORE CONSTANT THE VARIANCE.
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/6
C     ORIGINAL VERSION--MAY       1987.
C     UPDATED         --DECEMBER  1993.  CHARACTER*4 ICASPL
C     UPDATED         --FEBRUARY  1994.  CHANGE STAT TO RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1993
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION DISPAR(100)
      DIMENSION RATIO(100)
C
CCCCC THE FOLLOWING DIMENSIONS ARE TEMPORARY
      DIMENSION DISTX(100)
      DIMENSION DISTX3(100)
      DIMENSION Y3(100)
      DIMENSION SDY3(100)
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='DPBC'
      ISUBN2='H2  '
C
      IERROR='NO'
C
      AN1=0.0
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BCH2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBCH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,N1,NPLOTV
   53 FORMAT('ICASPL,MAXN,N1,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ALAMB1,ALAMB2
   54 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO62
      DO60I=1,N1
      WRITE(ICOUT,61)I,Y1(I),X1(I)
   61 FORMAT('I,Y1(I),X1(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
   62 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPBCH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N1
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPBCH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=X1(1)
      DO1130I=1,N1
      IF(X1(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPBCH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               *******************************************************
C               **  STEP 21--                                        **
C               **  DETERMINE THE SET OF PARAMETER VALUES            **
C               **  TO BE USED FOR THE TRANSFORMATIONS               **
C               *******************************************************
C
      NUMDIS=41
      ANUMDI=NUMDIS
      DO2100IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
 2100 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  DETERMINE THE NUMBER OF DISTINCT SUBSETS          **
C               **  FOR VARIABLE 1;                                   **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR THIS COMMAND **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      NUMSET=0
      DO2200I=1,N1
         IF(NUMSET.GE.1)THEN
            DO2300J=1,NUMSET
               IF(X1(I).EQ.DISTX(J))GOTO2200
 2300       CONTINUE
         ENDIF
         NUMSET=NUMSET+1
         DISTX(NUMSET)=X1(I)
 2200 CONTINUE
C
      IF(NUMSET.EQ.0.OR.NUMSET.EQ.N1)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2205)
 2205    FORMAT('*****ERROR IN DPBCH2--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2206)
 2206    FORMAT('     FOR A BOX-COX HOMOSCEDASTICITY PLOT,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2207)
 2207    FORMAT('     THERE MUST BE REPLICATION--BUT NO REPLICATION')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2208)
 2208    FORMAT('     WAS FOUND--ALL VALUES OF X WERE DISTINCT.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2209)NUMSET
 2209    FORMAT('     NUMSET = ',I8)
         CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
 2219 CONTINUE
C
C               ****************************************
C               **  STEP 32--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      DO3210I=1,N1
         X2(I)=X1(I)
 3210 CONTINUE
C
      YMIN=Y1(1)
      DO3220I=1,N1
         IF(Y1(I).LT.YMIN)YMIN=Y1(I)
 3220 CONTINUE
C
      DO3230I=1,N1
         D2(I)=Y1(I)
 3230 CONTINUE
C
      IF(YMIN.LE.0.0)THEN
         DO3240I=1,N1
            D2(I)=D2(I)-YMIN+1.0
 3240    CONTINUE
      ENDIF
C
      DO3300IDIS=1,NUMDIS
C
         ALAMBA=DISPAR(IDIS)
         IF(-0.001.LE.ALAMBA.AND.ALAMBA.LE.0.001)THEN
            DO3315I=1,N1
               Y2(I)=ALOG(D2(I))
 3315       CONTINUE
         ELSE
            DO3325I=1,N1
               Y2(I)=((D2(I)**ALAMBA)-1.0)/ALAMBA
 3325       CONTINUE
         ENDIF
C
         ISET3=0
         DO3410ISET=1,NUMSET
            I3=0
            DO3420I=1,N1
               IF(X2(I).EQ.DISTX(ISET))THEN
                  I3=I3+1
                  Y3(I3)=Y2(I)
               ENDIF
 3420       CONTINUE
            IF(I3.GE.2)THEN
               ISET3=ISET3+1
               DISTX3(ISET3)=DISTX(ISET)
               CALL SD(Y3,I3,IWRITE,SDY3(ISET3),IBUGG3,IERROR)
            ENDIF
 3410    CONTINUE
C
         CALL MINIM(SDY3,ISET3,IWRITE,AMINSD,IBUGG3,IERROR)
         CALL MAXIM(SDY3,ISET3,IWRITE,AMAXSD,IBUGG3,IERROR)
         RATIO(IDIS)=0.0
         IF(AMAXSD.GT.0.0)RATIO(IDIS)=AMINSD/AMAXSD
C
         IF(IBUGG3.EQ.'OFF')GOTO3439
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,3434)AMINSD,AMAXSD,RATIO(IDIS)
 3434    FORMAT('AMINSD,AMAXSD,RATIO(IDIS) = ',3E15.7)
         CALL DPWRST('XXX','BUG ')
 3439    CONTINUE
C
 3300 CONTINUE
C
 3500 CONTINUE
      DO3510IDIS=1,NUMDIS
         Y2(IDIS)=RATIO(IDIS)
         X2(IDIS)=DISPAR(IDIS)
         D2(IDIS)=1.0
 3510 CONTINUE
      N2=NUMDIS
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBCH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      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 DPBCNP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A BOX-COX NORMALITY 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--AUGUST    1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
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 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IERRO2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(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
      IERROR='NO'
C
      ISUBN1='DPBC'
      ISUBN2='NP  '
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 BOX-COX NORMALITY PLOT CASE  **
C               *********************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBCNP--')
      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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASPL='BCNP'
      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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')RETURN
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')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')RETURN
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL 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')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 DPBCNP--')
      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 BOX-COX NORMALITY 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'
      RETURN
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')CALL 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 DPBOX')
      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')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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
      IF(NUMV2.EQ.1)IDATSW='RAW'
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)IDATSW='FREQ'
      IF(NUMV2.EQ.2)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPBCNP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A BOX-COX NORMALITY 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 EITHER 1 OR 2  ;')
      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
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPBCNP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A BOX-COX NORMALITY PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (FREQUENCIES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
  584 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,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
C
      IF(NUMV2.LE.1)GOTO651
      GOTO652
C
  651 CONTINUE
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)X1(J)=TAGPLO(I)
      GOTO660
C
  652 CONTINUE
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)X1(J)=TAGPLO(I)
      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)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               ***********************************************
C               **  STEP 8--                                 **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED LIMITS                     **
C               **  FOR THE LAMBDA PARAMETER VALUES                 **
C               **  (THIS WILL DICTATE WHAT WILL APPEAR      **
C               **  ON THE HORIZONTAL AXIS OF THE BOX-COX NORMALITY PLOT) **
C               ***********************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHP='LAMB'
      IHP2='DA1 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB1=-2.0
      IF(IERRO2.EQ.'NO')ALAMB1=VALUE(ILOCP)
C
      IHP='LAMB'
      IHP2='DA2 '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      ALAMB2=2.0
      IF(IERRO2.EQ.'NO')ALAMB2=VALUE(ILOCP)
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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGG2.EQ.'OFF')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DPBCNP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV
 5112 FORMAT('ICASPL,NUMV2,IDATSW,NPLOTP,NPLOTV = ',A4,I8,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5113)ALAMB1,ALAMB2
 5113 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5121)NLOCAL
 5121 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO5129
      DO5122I=1,NLOCAL
      WRITE(ICOUT,5123)I,Y1(I),X1(I)
 5123 FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
      CALL DPWRST('XXX','BUG ')
 5122 CONTINUE
 5129 CONTINUE
      IF(NPLOTP.LE.0)GOTO5190
      DO5135I=1,NPLOTP
      WRITE(ICOUT,5136)I,Y(I),X(I),D(I)
 5136 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 5135 CONTINUE
 5190 CONTINUE
C
      CALL DPBCN2(Y1,X1,NLOCAL,ICASPL,IDATSW,
     1ALAMB1,ALAMB2,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
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 DPBCNP--')
      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)ALAMB1,ALAMB2
 9014 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NLOCAL
 9021 FORMAT('NLOCAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NLOCAL.LE.0)GOTO9029
      DO9022I=1,NLOCAL
      WRITE(ICOUT,9023)I,Y1(I),X1(I)
 9023 FORMAT('I,Y1(I),X1(I) = ',I8,2F12.5)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9029 CONTINUE
      IF(NPLOTP.LE.0)GOTO9090
      DO9032I=1,NPLOTP
      WRITE(ICOUT,9033)I,Y(I),X(I),D(I)
 9033 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBCN2(Y1,X1,N1,ICASPL,IDATSW,
     1ALAMB1,ALAMB2,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              THE BOX-COX NORMALITY PLOT TRACE
C              WHICH IS A PLOT OF THE NORMAL PROBABILITY PLOT
C              CORRELATION COEFFICIENT VERSUS THE BOX-COX PARAMATER LAMBDA.
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--AUGUST    1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1992. AN=N1  TO AN1=N1
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IDATSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION DISPAR(100)
      DIMENSION CORR(100)
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='DPBC'
      ISUBN2='N2  '
C
      IERROR='NO'
C
      AN1=0.0
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPBCN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,IDATSW,N1,NPLOTV
   72 FORMAT('ICASPL,IDATSW,N1,NPLOTV = ',A4,2X,A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ALAMB1,ALAMB2
   73 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO80
      DO85I=1,N1
      WRITE(ICOUT,86)I,Y1(I),X1(I)
   86 FORMAT('I,Y1(I),X1(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   80 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N1.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPBCN2--')
      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)N1
   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(N1.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPBCN2--')
      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=X1(1)
      DO60I=1,N1
      IF(X1(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPBCN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT 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
C               *******************************************************
C               **  STEP 2--                                         **
C               **  DETERMINE THE SET OF PARAMETER VALUES            **
C               **  TO BE USED FOR THE TRANSFORMATIONS               **
C               *******************************************************
C
  500 CONTINUE
C
  510 CONTINUE
      NUMDIS=41
      ANUMDI=NUMDIS
      DO511IDIS=1,NUMDIS
      AIDIS=IDIS
      DISPAR(IDIS)=ALAMB1+((AIDIS-1.0)/(ANUMDI-1.0))*(ALAMB2-ALAMB1)
  511 CONTINUE
      GOTO599
C
  599 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
      IF(IDATSW.EQ.'RAW')GOTO1100
      IF(IDATSW.EQ.'FREQ')GOTO2100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPBCN2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      IDATSW SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      RAW   OR    FREQ, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)IDATSW
 1014 FORMAT('      IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  DETERMINE PLOT COORDINATES        **
C               **  FOR THE 1-VARIABLE CASE           **
C               **  (THAT IS, FOR THE RAW DATA CASE)  **
C               ****************************************
C
 1100 CONTINUE
C
      CALL UNIMED(N1,X2)
      DO1110I=1,N1
      CALL NORPPF(X2(I),X2OUT)
      X2(I)=X2OUT
 1110 CONTINUE
C
      CALL SORT(X1,N1,D2)
      XMIN=D2(1)
      IF(XMIN.GT.0.0)GOTO1119
      DO1115I=1,N1
      D2(I)=D2(I)-XMIN+1.0
 1115 CONTINUE
 1119 CONTINUE
C
      DO1120IDIS=1,NUMDIS
      ALAMBA=DISPAR(IDIS)
      IF(-0.001.LE.ALAMBA.AND.ALAMBA.LE.0.001)GOTO1130
      GOTO1140
 1130 CONTINUE
      DO1135I=1,N1
      Y2(I)=ALOG(D2(I))
 1135 CONTINUE
      GOTO1149
 1140 CONTINUE
      DO1145I=1,N1
      Y2(I)=((D2(I)**ALAMBA)-1.0)/ALAMBA
 1145 CONTINUE
      GOTO1149
 1149 CONTINUE
C
      AN1=N1
      SUMY=0.0
      DO1810I=1,N1
      SUMY=SUMY+Y2(I)
 1810 CONTINUE
      XBAR=0.0
      YBAR=SUMY/AN1
C
      SUMX=0.0
      SUMY=0.0
      SUMXY=0.0
      DO1820I=1,N1
      SUMX=SUMX+(X2(I)-XBAR)*(X2(I)-XBAR)
      SUMY=SUMY+(Y2(I)-YBAR)*(Y2(I)-YBAR)
      SUMXY=SUMXY+(X2(I)-XBAR)*(Y2(I)-YBAR)
 1820 CONTINUE
      ARG=SUMX*SUMY
      CC=0.0
      IF(ARG.GT.0.0)CC=SUMXY/SQRT(ARG)
      CORR(IDIS)=CC
C
      IF(IBUGG3.EQ.'OFF')GOTO1839
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1831I=1,N1
      WRITE(ICOUT,1833)I,Y1(I),X1(I),Y2(I),X2(I),D2(I),CORR(I)
 1833 FORMAT('I,Y1(I),X1(I),Y2(I),X2(I),D2(I),CORR(I) = ',I8,6E12.5)
      CALL DPWRST('XXX','BUG ')
 1831 CONTINUE
      WRITE(ICOUT,1834)ICASPL,IDATSW,XBAR,YBAR,SUMX,SUMY,SUMXY
 1834 FORMAT('ICASPL,IDATSW,XBAR,YBAR,SUMX,SUMY,SUMXY = ',
     1A4,2X,A4,2X,5E15.7)
      CALL DPWRST('XXX','BUG ')
 1839 CONTINUE
C
 1120 CONTINUE
C
 1900 CONTINUE
      DO1910IDIS=1,NUMDIS
      Y2(IDIS)=CORR(IDIS)
      X2(IDIS)=DISPAR(IDIS)
      D2(IDIS)=1.0
 1910 CONTINUE
      N2=NUMDIS
      NPLOTV=2
      GOTO9000
C
C               ********************************************
C               **  STEP 4.2--                            **
C               **  DETERMINE PLOT COORDINATES            **
C               **  FOR THE 2-VARIABLE CASE               **
C               **  (THAT IS, FOR THE GROUPED DATA CASE)  **
C               ********************************************
C
 2100 CONTINUE
      CALL SORTC(X1,Y1,N1,D2,Y2)
      XMIN=D2(1)
      IF(XMIN.GT.0.0)GOTO2109
      DO2105I=1,N1
      D2(I)=D2(I)-XMIN+1.0
 2105 CONTINUE
 2109 CONTINUE
C
      I2=0
      DO2111I=1,N1
      NI=Y2(I)
      ANI=NI
      I1=I2+1
      I2=I1+NI-1
      SUM=0.0
      DO2112K=I1,I2
      CALL UNIME2(NTOT,K,UNIOSM)
      CALL NORPPF(UNIOSM,DISOSM)
      SUM=SUM+DISOSM
 2112 CONTINUE
      X2(I)=SUM/ANI
 2111 CONTINUE
C
      SUM=0.0
      DO2115I=1,N1
      SUM=SUM+Y1(I)
 2115 CONTINUE
      NTOT=SUM+0.5
C
      DO2120IDIS=1,NUMDIS
      ALAMBA=DISPAR(IDIS)
      IF(-0.001.LE.ALAMBA.AND.ALAMBA.LE.0.001)GOTO2130
      GOTO2140
 2130 CONTINUE
      DO2135I=1,N1
      Y2(I)=ALOG(D2(I))
 2135 CONTINUE
      GOTO2149
 2140 CONTINUE
      DO2145I=1,N1
      Y2(I)=((D2(I)**ALAMBA)-1.0)/ALAMBA
 2145 CONTINUE
      GOTO2149
 2149 CONTINUE
C
CCCCC THE FOLLOWING LINE WAS FIXED    APRIL 1992 (ALAN)
CCCCC AN=N1
      AN1=N1
      SUMY=0.0
      DO2810I=1,N1
      SUMY=SUMY+Y2(I)
 2810 CONTINUE
      XBAR=0.0
      YBAR=SUMY/AN1
C
      SUMX=0.0
      SUMY=0.0
      SUMXY=0.0
      DO2820I=1,N1
      SUMX=SUMX+(X2(I)-XBAR)*(X2(I)-XBAR)
      SUMY=SUMY+(Y2(I)-YBAR)*(Y2(I)-YBAR)
      SUMXY=SUMXY+(X2(I)-XBAR)*(Y2(I)-YBAR)
 2820 CONTINUE
      ARG=SUMX*SUMY
      CC=0.0
      IF(ARG.GT.0.0)CC=SUMXY/SQRT(ARG)
      CORR(IDIS)=CC
C
 2120 CONTINUE
C
 2900 CONTINUE
      DO2910IDIS=1,NUMDIS
      Y2(IDIS)=CORR(IDIS)
      X2(IDIS)=DISPAR(IDIS)
      D2(IDIS)=1.0
 2910 CONTINUE
      N2=NUMDIS
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBCN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,N2,IERROR
 9012 FORMAT('ICASPL,IDATSW,N2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NTOT
 9014 FORMAT('NTOT = ',I8)
      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 DPBECP(IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--FIND THE (10) BEST CANDIDATE MODELS FOR A LINEAR FIT
C              BASED ON MALLOW'S CP CRITERION.  CODE EXTRACTED
C              FROM OMNITAB, WHICH USES THE FURNIVAL AND WILSON
C              LEAP AND BOUND ALGORITHM.
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--2002/6
C     ORIGINAL VERSION--JULY     2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC SUPPORT MAXIMUM OF 38 INDPENDENT VARIABLES, CORRELATION
CCCCC MATRIX ALSO NEEDS TO INCLUDE CONSTANT TERM AND DEPENDENT
CCCCC VARIABLE.
      PARAMETER (MAXV=38)
      PARAMETER (MAXC=MAXV+2)
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASFI
      CHARACTER*4 ICASEQ
      CHARACTER*4 IKEY
CCCCC CHARACTER*4 IHWUSE
CCCCC CHARACTER*4 MESSAG
      CHARACTER*4 IHRESP(MAXC)
      CHARACTER*4 IHRES2(MAXC)
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHO.INC'
C
      DOUBLE PRECISION SQRTCT(MAXOBV)
      INTEGER ILOCRV(MAXC)
      INTEGER ICOLRV(MAXC)
      REAL RXY(MAXC,MAXC)
      REAL XYMAT(MAXOBV*MAXC)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
      CHARACTER*8 IVLIST
      COMMON/BESTC1/IOUNI1,IOUNI2
      COMMON/BESTC2/IVLIST(MAXV)
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZD.INC'
      EQUIVALENCE (GARBAG(IGARB1),RXY(1,1))
      EQUIVALENCE (G2RBAG(IGAR11),XYMAT(1))
      EQUIVALENCE (DGARBG(IDGAR1),SQRTCT(1))
C
      CHARACTER*4 IBUGAZ
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='DPBE'
      ISUBN2='CP  '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=MAXC
      MINV2=4
      MINN2=2
      NQ=1
C
      NUMPV=(-999)
      IP=(-999)
      IV=(-999)
C
      IWIDMO=(-999)
C
      NUMIND=(-999)
C
C               ******************************
C               **  TREAT THE BEST CP CASE  **
C               ******************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BECP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBECP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMNAM
   56 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMNAM
      WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   58 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
   90 CONTINUE
C
C     ***************************
C     **  STEP 1--             **
C     **  EXTRACT THE COMMAND  **
C     ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'BEST'.AND.IHARG(1).EQ.'CP  ')GOTO111
      IF(ICOM.EQ.'BEST'.AND.ICOM2.EQ.'CP  ')GOTO180
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASFI='BECP'
C
C     *******************************************************
C     **  STEP 2--                                         **
C     **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C     *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C     ******************************************************
C     **  STEP 3--                                        **
C     **  FOR THE CASES WHEN HAVE FIT Y = SOME EXPRESSION **
C     **  DETERMINE IF WE HAVE A VALID FUNCTIONAL         **
C     **  EXPRESSION--IN PARTICULAR, CHECK THAT THE NUMBER**
C     **  OF ARGUMENTS IS AT LEAST 1, AND ALSO CHECK      **
C     **  THAT THERE IS EXACTLY 1 EQUAL SIGN AND THAT     **
C     **  THIS EQUAL SIGN OCCURS AS THE SECOND ARGUMENT.  **
C     ******************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.MINV2)THEN
        WRITE(ICOUT,2001)
 2001   FORMAT('***** ERROR IN DPBECP--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2002)
 2002   FORMAT('      NUMBER OF ARGUMENTS DETECTED IN BEST CP COMMAND',
     1         ' < 4.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2003)NUMARG
 2003   FORMAT('      NEED DEPENDENT VARIABLE AND AT LEAST 3 ',
     1         'INDEPENDENT VARIABLES.  NUMARG = ',I3)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2008)(IANS(J),J=1,MIN(100,IWIDTH))
 2008     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      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.'    ')GOTO2110
 2100 CONTINUE
      ILOCQ=NUMARG+1
      GOTO2120
 2110 CONTINUE
      ILOCQ=J1
      GOTO2120
 2120 CONTINUE
C
      NQ=ILOCQ-1
C
      IF(NQ.GT.MAXV+1)THEN
        WRITE(ICOUT,2145)MAXV+1
 2145   FORMAT('**** ERROR FROM BEST CP: MAXIMIUM NUMBER OF VARIABLES,',
     1         I5,', EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     ****************************************************
C     **  STEP 4--                                      **
C     **  FOR ALL VARIATIONS OF THE COMMAND,            **
C     **  THE WORD AFTER  FIT  SHOULD BE THE RESPONSE   **
C     **  VARIABLE (= THE DEPENDENT VARIABLE).          **
C     **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE   **
C     **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN  **
C     **  FACT, A VARIABLE (AS OPPOSED TO A PARAMETER). **
C     **  NOTE: FOR IMPLICIT MODEL, NO RESPONSE         **
C     **        VARIABLE.                               **
C     ****************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2310J=1,NQ
        ILOCF1=J
        IF(J.EQ.1)THEN
          IHLEFT=IHARG(ILOCF1)
          IHLEF2=IHARG2(ILOCF1)
        ENDIF
        IHRESP(J)=IHARG(ILOCF1)
        IHRES2(J)=IHARG2(ILOCF1)
C
CCCCC INDEPENDENT VARIABLE LIST FOR OMNITAB BEST CP CODE.
C
        IF(J.GT.1)THEN
          JM1=J-1
          IVLIST(JM1)(1:4)=IHRESP(J)
          IVLIST(JM1)(5:8)=IHRES2(J)
        ENDIF
C
        DO2350I=1,NUMNAM
          I2=I
          IF(IHRESP(J).EQ.IHNAME(I2).AND.IHRES2(J).EQ.IHNAM2(I2).AND.
     1       IUSE(I2).EQ.'V')GOTO2379
 2350   CONTINUE
        WRITE(ICOUT,2361)
 2361   FORMAT('***** ERROR IN DPBECP (BEST CP)--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2362)
 2362   FORMAT('      THE NAME AFTER  THE WORD BEST CP')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2363)
 2363   FORMAT('      (WHICH SHOULD BE THE DEPENDENT VARIABLE)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2364)
 2364   FORMAT('      EITHER DOES NOT EXIST OR IS A PARAMETER ',
     1         '(AS OPPOSED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2366)
 2366   FORMAT('      TO A VARIABLE) IN THE CURRENT LIST OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2367)
 2367   FORMAT('      AVAILABLE VARIABLE AND PARAMETER NAMES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2369)IHRESP(J),IHRES2(J)
 2369   FORMAT('      NAME AFTER THE WORD BEST CP = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2378     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
C
 2379   CONTINUE
        IF(J.EQ.1)THEN
          ILOCV=I2
          ICOLL=IVALUE(ILOCV)
          NLEFT=IN(ILOCV)
        ELSE
          ILOCRV(J)=I2
          ICOLRV(J)=IVALUE(ILOCRV(J))
          NTEMP=IN(ILOCRV(J))
          IF(NTEMP.NE.NLEFT)THEN
            WRITE(ICOUT,2381)
 2381       FORMAT('***** ERROR IN DPBECP (BEST CP)--ALL INDEPENDENT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2383)
 2383       FORMAT('      VARIABLES MUST HAVE THE SAME NUMBER OF ',
     1             'OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2385)IHRESP(J),IHRES2(J),NTEMP
 2385       FORMAT('      INDEPENDENT VARIABLE ',A4,A4,' HAS ',I8,
     1             'OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2387)NLEFT
 2387       FORMAT('      NUMBER OF OBSEVATIONS EXPECTED: ',I8)
            CALL DPWRST('XXX','BUG ')
            IF(IWIDTH.GE.1)THEN
              WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 2310 CONTINUE
C
 2390 CONTINUE
C
C     ****************************************************
C     **  STEP 5--                                      **
C     **  FOR ALL VARIATIONS OF THE COMMAND, CHECK THAT **
C     **  THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C     **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER AND  **
C     **  LESS THAN MAXOB2.                             **
C     ****************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NJUNK=MAX(MINN2,NQ-1)
      IF(NLEFT.GE.MINN2.AND.NLEFT.LE.MAXOBV)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPBECP (BEST CP)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS (FOR WHICH A ',
     1'(IN VARIABLE ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      BEST CP ANALYSIS WAS TO HAVE BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      PERFORMED MUST BE AT LEAST ',I8,' AND NO MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      THAN ',I8,';  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,319)(IANS(I),I=1,MIN(100,IWIDTH))
  319   FORMAT(100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C     **********************************************
C     **  STEP 6.3--                              **
C     **  FOR ALL VARIATIONS OF THE FIT COMMAND,  **
C     **  CHECK TO SEE THE TYPE CASE--            **
C     **    1) UNQUALIFIED (THAT IS, FULL);       **
C     **    2) SUBSET/EXCEPT; OR                  **
C     **    3) FOR.                               **
C     **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL 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'
      IKEY='SUBS'
      IF(IHARG(J1).EQ.'EXCE')IKEY='EXCE'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BECP')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C     *****************************************************
C     **  STEP 12--                                      **
C     **  BRANCH TO THE APPROPRIATE SUBCASE; THEN        **
C     **  COPY OVER THE DEPENDENT VARIABLE AND THE       **
C     **  THE INDPENENDENT VARIABLES INTO THE MATRIX     **
C     **  XYMAT.  ALSO, CREATE A COLUMN OF "1"'s IN THE  **
C     **  MODEL INCLUDES AN ADDITIVE CONSTANT.           **
C     *****************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,601)N,ILOCQ-1
  601   FORMAT('N,ILOCQ-1 = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      NTEMP=NLEFT
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NTEMP
      ISUB(I)=1
  615 CONTINUE
      NQZ=NTEMP
      GOTO650
C
  620 CONTINUE
      NIOLD=NTEMP
      CALL DPSUB2(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NTEMP
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NFOR
      GOTO650
C
  650 CONTINUE
      IFACT=1
      IF(IFITAC.EQ.'OFF')IFACT=0
C
      J=0
      DO4450I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4450
        J=J+1
 4450 CONTINUE
      NS=J
C
      J=0
      NFRST=2
      NLAST=ILOCQ-1
      ISTRT=NS*(NLAST-NFRST+1)
      DO4500I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4500
        K=ICOLL
        J=J+1
        IJ=MAXN*(K-1)+I
        IF(K.LE.MAXCOL)XYMAT(ISTRT+J)=V(IJ)
        IF(K.EQ.MAXCP1)XYMAT(ISTRT+J)=PRED(I)
        IF(K.EQ.MAXCP2)XYMAT(ISTRT+J)=RES(I)
        IF(K.EQ.MAXCP3)XYMAT(ISTRT+J)=YPLOT(I)
        IF(K.EQ.MAXCP4)XYMAT(ISTRT+J)=XPLOT(I)
        IF(K.EQ.MAXCP5)XYMAT(ISTRT+J)=X2PLOT(I)
        IF(K.EQ.MAXCP6)XYMAT(ISTRT+J)=TAGPLO(I)
 4500 CONTINUE
C
CCCCC NOTE: CONSTANT COLUMN IS NOT INCLUDED IN THE
CCCCC DESIGN MATRIX.
C
CCCCC IF(IFITAC.EQ.'ON')THEN
CCCCC   DO4510I=1,NS
CCCCC     XYMAT(I)=1.0
C4510   CONTINUE
CCCCC   ISTRT=2*NS
CCCCC ENDIF
C
      J=0
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4501)
 4501   FORMAT('***** FROM DPBECP, FORMING XYMAT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4503)NS,NFRST,NLAST,IFACT
 4503   FORMAT('NS,NFRST,NLAST,IFACT = ',4(I8,2X))
        CALL DPWRST('XXX','BUG ')
        DO4505I=1,ILOCQ
        WRITE(ICOUT,4507)I,ICOLRV(I),ILOCRV(I)
 4507   FORMAT('I,ICOLRV(I),ILOCRV(I) = ',3(I8,2X))
        CALL DPWRST('XXX','BUG ')
 4505   CONTINUE
      ENDIF
C
      DO4520I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4520
        J=J+1
        DO4600L=NFRST,NLAST
          K=ICOLRV(L)
          IJ=MAXN*(K-1)+I
          ISTRT=NS*(L-NFRST)
          IF(K.LE.MAXCOL)XYMAT(J+ISTRT)=V(IJ)
          IF(K.EQ.MAXCP1)XYMAT(J+ISTRT)=PRED(I)
          IF(K.EQ.MAXCP2)XYMAT(J+ISTRT)=RES(I)
          IF(K.EQ.MAXCP3)XYMAT(J+ISTRT)=YPLOT(I)
          IF(K.EQ.MAXCP4)XYMAT(J+ISTRT)=XPLOT(I)
          IF(K.EQ.MAXCP5)XYMAT(J+ISTRT)=X2PLOT(I)
          IF(K.EQ.MAXCP6)XYMAT(J+ISTRT)=TAGPLO(I)
 4600   CONTINUE
C
 4520 CONTINUE
      NVARS=NLAST-NFRST+2
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CARRY OUT THE ACTUAL FIT                        **
C               **  VIA CALLING                                     **
C               **  DPBECP2 (FOR GENERAL MODELS), OR                **
C               ******************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IBUGAZ=IBUGA3
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BECP')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPBECP, AS ABOUT TO CALL DPBEC2--')
      CALL DPWRST('XXX','BUG ')
      DO6083I=1,NS*NVARS
      WRITE(ICOUT,6084)I,XYMAT(I)
 6084 FORMAT('I,(XYMAT(I) = ',I6,2X,G15.7)
      CALL DPWRST('XXX','BUG ')
 6083 CONTINUE
      WRITE(ICOUT,6082)NLEFT,MAXN,NS,NVARS
 6082 FORMAT('NLEFT,MAXN,NS,NVARS = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6091)IBUGA3,IBUGCO,IBUGEV
 6091 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
 6520 CONTINUE
C
      INTCPT=IFACT
      MBEST=INUMCP
      IF(NVARS-1.LE.3 .AND. MBEST.GT.7)MBEST=7
      CALL DPBEC2(XYMAT,N,NVARS,SQRTCT,RXY,
     1MAXC,MAXV,
     1MBEST,INTCPT,
     1IBUGA3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO6590
C
 6590 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BECP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BECP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBECP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3,NS
 9012 FORMAT('IBUGA2,IBUGA3,NS = ',A4,2X,A4,1X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMNAM
 9016 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9017I=1,NUMNAM
      WRITE(ICOUT,9018)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9018 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
 9042 CONTINUE
 9049 CONTINUE
      WRITE(ICOUT,9051)NLEFT,NS,V(1),PRED(1),RES(1)
 9051 FORMAT('NLEFT,NS,V(1),PRED(1),RES(1) = ',2I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)ICASEQ
 9052 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)IWIDTH
 9061 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,9062)(IANS(I),I=1,MIN(100,IWIDTH))
 9062   FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,9069)IFOUND,IERROR
 9069 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBEC2(XYMAT,N,NVARS,SQRTCT,RXY,
     1MAXC,MAXV,
     1MBEST,INTCPT,
     1IBUGA3,ISUBRO,IERROR)
C
C     BEST CP: COMPUTE MBEST (DEFAULT=10) BEST CANDIDATE MODELS BASED
C     ON MALLOW'S CP CRITIERION.  CODE EXTRACTED FROM OMNITAB, WHICH
C     IMPLEMENTS THE FURNIVAL AND WILSON LEAP AND BOUND ALGORITHM.
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--2002/6
C     ORIGINAL VERSION--JUNE      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      INTEGER N, NVARS
C
      DOUBLE PRECISION SQRTCT(*)
      REAL RXY(MAXC,MAXC)
      REAL XYMAT(*)
C
      PARAMETER (MAXV2=38)
      CHARACTER*8 IVLIST
      COMMON/BESTC1/IOUNI1,IOUNI2
      COMMON/BESTC2/IVLIST(MAXV2)
C
      INCLUDE 'DPCOF2.INC'
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='DPBE'
      ISUBN2='C2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'BEC2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBEC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NVARS,MBEST,INTCPT
   52 FORMAT('N,NVARS,MBEST,INTCPT = ',4I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 0.5--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='0.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FIT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='BEC2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='BEC2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  CALL OMNITAB ROUTINES CRSPRD AND SCREEN.       **
C               *****************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BEC2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL CRSPRD(XYMAT,N,NVARS,INTCPT,SQRTCT,RXY,MAXC)
C
      NDF=N-1
      NPARAM=NVARS-1
      ITYPE=3
      NSPAC=MAXC*20000
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BEC2')THEN
         WRITE(ICOUT,7112)N,NVARS
 7112    FORMAT(6X,'AFTER CALL TO CRSPRD, N, NVARS = ',2I8)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,7113)NDF,NPARAM
 7113    FORMAT(6X,'NDF,NPARAM = ',2I8)
         CALL DPWRST('XXX','BUG ')
         DO7115I=1,NVARS
         WRITE(ICOUT,7117)I,(RXY(I,J),J=1,MIN(NVARS,7))
 7117    FORMAT('ROW ',I5,' = ',7(G15.7))
         CALL DPWRST('XXX','BUG ')
 7115    CONTINUE
      ENDIF
C
      CALL SCREEN(RXY,NPARAM,MAXC,NDF,ITYPE,MBEST,INTCPT,XYMAT,NSPAC)
C
C               ****************************************************
C               **  STEP 3--                                      **
C               **  WRITE INFO OUT TO FILES--                     **
C               **     1) DPST1F.DAT--XXXXX                       **
C               ****************************************************
C
 8100 CONTINUE
C
      ISTEPN='81'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BEC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO8119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)
 8112 FORMAT(6X,'NUMBER OF VARIABLES, CP VALUE, VARIABLE LIST WRITTEN ',
     1      'TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)
 8114 FORMAT(6X,'CODED VARIABLE LIST WRITTEN TO TO FILE DPST2F.DAT')
      CALL DPWRST('XXX','BUG ')
 8119 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO8129
 8129 CONTINUE
C
C               **************************************
C               **  STEP 82--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8200 CONTINUE
C
      ISTEPN='82'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FIT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'BEC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBEC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBELL(IHARG,NUMARG,IBELSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BELL SWITCH IBELSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IBELSW  ('ON'  OR 'OFF')
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       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IBELSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.GE.1)GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IBELSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IBELSW='OFF'
      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)IBELSW
 1181 FORMAT('THE BELL SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBFCO(IHARG,NUMARG,IDEBFC,MAXBAR,IBAFCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR FILL COLORS = THE COLORS
C              OF THE (BACKGROUND) FILL WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBAFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBFC
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBAFCO (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBFC
      CHARACTER*4 IBAFCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBAFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBF'
      ISUBN2='CO  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBFC
   55 FORMAT('IDEBFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBAFCO(1)
   70 FORMAT('IBAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBAFCO(I)
   76 FORMAT('I,IBAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBAFCO(1)=IDEBFC
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBFC
      IBAFCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBAFCO(I)
 1276 FORMAT('THE FILL COLOR OF BAR ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBFC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBFC
      DO1315I=1,NUMBAR
      IBAFCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBAFCO(I)
 1316 FORMAT('THE FILL COLOR OF ALL BARS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBFCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBFC
 9015 FORMAT('IDEBFC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBAFCO(1)
 9030 FORMAT('IBAFCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBAFCO(I)
 9036 FORMAT('I,IBAFCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBFSW(IHARG,NUMARG,IDEBFS,MAXBAR,IBAFSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR FILL SWITCHES = THE ON/OFF SWITCHES
C              OF THE (BACKGROUND) FILL WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBAFSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBFS
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBAFSW (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBFS
      CHARACTER*4 IBAFSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBAFSW(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBF'
      ISUBN2='SW  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBFS
   55 FORMAT('IDEBFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBAFSW(1)
   70 FORMAT('IBAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBAFSW(I)
   76 FORMAT('I,IBAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBAFSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBFS
      IBAFSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBAFSW(I)
 1276 FORMAT('THE FILL SWITCH FOR BAR ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBFS
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBFS
      DO1315I=1,NUMBAR
      IBAFSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBAFSW(I)
 1316 FORMAT('THE FILL SWITCH FOR ALL BARS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBFSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBFS
 9015 FORMAT('IDEBFS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBAFSW(1)
 9030 FORMAT('IBAFSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBAFSW(I)
 9036 FORMAT('I,IBAFSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBIHI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
     1Y1,Y2,C1,C2,
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
     1IRHSTG,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 2 PLOTS--
C              1) BIHISTOGRAM;
C              2) RELATIVE BIHISTOGRAM;
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C     UPDATED         --MARCH 1996.  IRHSTG SWITCH
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 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IDATSW
      CHARACTER*4 IHLE11
      CHARACTER*4 IHLE12
      CHARACTER*4 IHLE21
      CHARACTER*4 IHLE22
CCCCC CHARACTER*4 IHRIGH
CCCCC CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
      CHARACTER*4 IRHSTG
C
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
CCCCC DIMENSION BAWIDT(*)
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION C1(*)
      DIMENSION C2(*)
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='DPBI'
      ISUBN2='HI  '
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
      ICOLL2=0
C
      NUMV2=2
C
C               *******************************************
C               **  TREAT THE BIHISTOGRAM AND RELATED    **
C               **  STATISTICAL DISTRIBUTION PLOTS CASE  **
C               *******************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBIHI--')
      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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'BIHI')GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'BIHI')GOTO120
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='BIHI'
      IRELAT='OFF'
      GOTO180
C
  120 CONTINUE
      ICASPL='BIHI'
      IRELAT='ON'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL 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 FIRST RESPONSE VARIABLE)  **
C               **  CHECK THE VALIDITY OF ARGUMENT 2            **
C               **  (THIS WILL BE THE SECOND RESPONSE VARIABLE) **
C               **************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLE11=IHARG(1)
      IHLE12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLE11,IHLE12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL1=IVALUE(ILOCV)
      NLEFT1=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLE11,IHLE12,ICOLL1,NLEFT1
  211 FORMAT('IHLE11,IHLE12,ICOLL1,NLEFT1 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IHLE21=IHARG(2)
      IHLE22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLE21,IHLE22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL2=IVALUE(ILOCV)
      NLEFT2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,221)IHLE21,IHLE22,ICOLL2,NLEFT2
  221 FORMAT('IHLE21,IHLE22,ICOLL2,NLEFT2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT1)     **
C               **  FOR THE FIRST RESPONSE VARIABLE IS POSITIVE.             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT2)     **
C               **  FOR THE SECOND RESPONSE VARIABLE IS POSITIVE.            **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT1.GE.MINN2.AND.NLEFT2.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPBIHI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'BIHI'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A BIHISTOGRAM ')
      IF(ICASPL.EQ.'BIHI'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'BIHI'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A RELATIVE BIHISTOGRAM ')
      IF(ICASPL.EQ.'BIHI'.AND.IRELAT.EQ.'ON')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
  390 CONTINUE
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(IBUGG2.EQ.'ON')CALL 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 DPBIHI')
      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')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               **  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='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLEFMX=NLEFT1
      IF(NLEFT2.GT.NLEFT1)NLEFMX=NLEFT2
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFMX
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFMX
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFMX
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFMX
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT1
      IF(NQ.LT.NLEFT1)IMAX=NQ
      DO651I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO651
      J=J+1
      IJ=MAXN*(ICOLL1-1)+I
      IF(ICOLL1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
  651 CONTINUE
      N1=J
C
      J=0
      IMAX=NLEFT2
      IF(NQ.LT.NLEFT2)IMAX=NQ
      DO652I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO652
      J=J+1
      IJ=MAXN*(ICOLL2-1)+I
      IF(ICOLL2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLL2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLL2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLL2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLL2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLL2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLL2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
  652 CONTINUE
      N2=J
C
C               ****************************************************************
C               **  STEP 7--
C               **  DETERMINE IF THE ANALYST
C               **  HAS SPECIFIED    1)  THE CLASS WIDTH,
C               **                   2)  THE MIN POINT OF THE FIRST CELL,
C               **                   3)  THE MAX POINT OF THE LAST  CELL,
C               **  FOR THE DISTRIBUTIONAL ANALYSIS.
C               **  IF NON-DEFAULT, USE THE SPECIFIED VALUES.
C               **  IF DEFAULT, USE THE DEFAULT VALUES--
C               **     1)  CLASS WIDTH = .3 OF A SAMPLE STANDARD DEVIATION;
C               **     2)  START = SAMPLE MEAN - 6*(SAMPLE STANDARD DEVIATION);
C               **     3)  STOP  = SAMPLE MEAN + 6*(SAMPLE STANDARD DEVIATION);
C               **  NOTE THAT THE DEFAULT SETTINGS ARE IN FACT
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CLWID=CLWIDT(1)
CCCCC BAWID=BAWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
C
C               *****************************************************
C               **  STEP 8--                                       **
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
      CALL DPBIH2(Y1,N1,Y2,N2,ICASPL,IRELAT,MAXN,
     1CLWID,XSTART,XSTOP,
     1C1,C2,
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
     1IRHSTG,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
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 DPBIHI--')
      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)IRELAT,CLWID,XSTART,XSTOP
 9014 FORMAT('IRELAT,CLWID,XSTART,XSTOP = ',A4,2X,3E15.7)
      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 DPBIH2(Y1,N1,Y2,N2,ICASPL,IRELAT,MAXN,
     1CLWID,XSTART,XSTOP,
     1C1,C2,
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
     1IRHSTG,
     1Y9,X9,D9,N9,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A BIHISTOGRAM,
C                   2) A RELATIVE BIHISTOGRAM
C                      (THAT IS, WITH AREA = 1).
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C     UPDATED         --JANUARY   1989.   DOUBLE PRECISION (MANY PLACES)
C     UPDATED         --JUNE      1995.   FIX RELATIVE BIHIST PROBLEM
C     UPDATED         --MARCH     1996.   FIX RELATIVE BIHIST PROBLEM
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IRELAT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
C
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN9
C
C---------------------------------------------------------------------
 
      DOUBLE PRECISION DCLWID
      DOUBLE PRECISION DXSTAR
      DOUBLE PRECISION DXSTOP
      DOUBLE PRECISION DCLMNJ
      DOUBLE PRECISION DCLMDJ
      DOUBLE PRECISION DCLMXJ
      DOUBLE PRECISION DJ
      DOUBLE PRECISION DY1I
      DOUBLE PRECISION DY2I
      DOUBLE PRECISION DABSDE
      DOUBLE PRECISION DTOTWI
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION C1(*)
      DIMENSION C2(*)
      DIMENSION Y9(*)
      DIMENSION X9(*)
      DIMENSION D9(*)
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='DPBI'
      ISUBN9='H2  '
C
      IERROR='NO'
C
      AN1=N1
      AN2=N2
C
      DCLWID=CLWID
      DXSTAR=XSTART
      DXSTOP=XSTOP
C
      K=(-999)
      DCLMDJ=(-999.0D0)
C
      SUM1=0.0
      SUM2=0.0
      DENOM1=0.0
      DENOM2=0.0
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N1.GE.1)GOTO39
      IF(N1.GE.1.AND.N2.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPBIH2--')
      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)N1,N2
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPBIH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N1,N2,CLWID,XSTART,XSTOP
   72 FORMAT('N1,N2,CLWID,XSTART,XSTOP = ',2I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N1
      WRITE(ICOUT,74)I,Y1(I)
   74 FORMAT('I, Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
      DO75I=1,N2
      WRITE(ICOUT,76)I,Y2(I)
   76 FORMAT('I, Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   80 CONTINUE
C
C               **********************************************
C               **  STEP 11--                               **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
      IF(CLWID.NE.CPUMIN.AND.DXSTAR.NE.CPUMIN.AND.
     1DXSTOP.NE.CPUMAX)GOTO1119
C
      IWRIT2='OFF'
      CALL MEAN(Y1,N1,IWRIT2,YMEAN1,IBUGG3,IERROR)
      CALL MEAN(Y2,N2,IWRIT2,YMEAN2,IBUGG3,IERROR)
      YMEAN=(AN1*YMEAN1+AN2*YMEAN2)/(AN1+AN2)
      SUM=0.0
      DO1121I=1,N1
      SUM=SUM+(Y1(I)-YMEAN)**2
 1121 CONTINUE
      DO1122I=1,N2
      SUM=SUM+(Y2(I)-YMEAN)**2
 1122 CONTINUE
      YVAR=SUM/(AN1+AN2-1.0)
      YSD=SQRT(YVAR)
C
      IF(CLWID.EQ.CPUMIN)DCLWID=0.3*YSD
      IF(DXSTAR.EQ.CPUMIN)DXSTAR=YMEAN-6.0*YSD
      IF(DXSTOP.EQ.CPUMAX)DXSTOP=YMEAN+6.0*YSD
C
 1119 CONTINUE
      DTOTWI=DXSTOP-DXSTAR
      ANUMCL=DTOTWI/DCLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      DABSDE=DABS(DCLMXJ-DXSTOP)
      IF(DABSDE.LE.0.0001D0)NUMCLA=NUMCLA-1
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  DETERMINE THE CLASS COUNTS FOR RESPONSE VARIABLE 1  **
C               **********************************************************
C
      DO2110J=1,NUMCLA
      C1(J)=0.0
 2110 CONTINUE
C
      DO2120I=1,N1
      DY1I=Y1(I)
      DO2130J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DY1I.AND.DY1I.LT.DCLMXJ)GOTO2135
 2130 CONTINUE
      GOTO2120
 2135 CONTINUE
      C1(J2)=C1(J2)+1.0
 2120 CONTINUE
C
      J=NUMCLA
      DO2150I=1,N1
      DY1I=Y1(I)
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DY1I.EQ.DCLMXJ)C1(J)=C1(J)+1.0
 2150 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO2165
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2161)
 2161 FORMAT('***** IN THE MIDDLE    OF DPBIH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2162)DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA
 2162 FORMAT('DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA= ',
     14D11.4,E11.4,I8)
      CALL DPWRST('XXX','BUG ')
      DO2163J=1,NUMCLA
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      FJ=C1(J)
      WRITE(ICOUT,2164)J,DCLMNJ,DCLMXJ,FJ
 2164 FORMAT('J,DCLMNJ,DCLMXJ,FJ = ',I8,2D15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 2163 CONTINUE
 2165 CONTINUE
C
C               **********************************************************
C               **  STEP 22--                                           **
C               **  DETERMINE THE CLASS COUNTS FOR RESPONSE VARIABLE 2  **
C               **********************************************************
C
      DO2210J=1,NUMCLA
      C2(J)=0.0
 2210 CONTINUE
C
      DO2220I=1,N2
      DY2I=Y2(I)
      DO2230J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DY2I.AND.DY2I.LT.DCLMXJ)GOTO2235
 2230 CONTINUE
      GOTO2220
 2235 CONTINUE
      C2(J2)=C2(J2)+1.0
 2220 CONTINUE
C
      J=NUMCLA
      DO2250I=1,N2
      DY2I=Y2(I)
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DY2I.EQ.DCLMXJ)C2(J)=C2(J)+1.0
 2250 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO2265
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2261)
 2261 FORMAT('***** IN THE MIDDLE    OF DPBIH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2262)DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA
 2262 FORMAT('DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA= ',
     14D11.4,E11.4,I8)
      CALL DPWRST('XXX','BUG ')
      DO2263J=1,NUMCLA
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      FJ=C2(J)
      WRITE(ICOUT,2264)J,DCLMNJ,DCLMXJ,FJ
 2264 FORMAT('J,DCLMNJ,DCLMXJ,FJ = ',I8,2D15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 2263 CONTINUE
 2265 CONTINUE
C
C               **********************************
C               **  STEP 31--                   **
C               **  DETERMINE PLOT COORDINATES  **
C               **  FOR RESPONSE VARIABLE 1     **
C               **********************************
C
      SUM1=0.0
      DO3110J=1,NUMCLA
      FJ=C1(J)
      SUM1=SUM1+FJ
 3110 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1995
      AN3=SUM1
C
      DENOM1=1.0
CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1995
CCCCC IF(IRELAT.EQ.'ON')DENOM1=SUM1
CCCCC IF(IRELAT.EQ.'ON')DENOM1=AN3*DCLWID
CCCCC MARCH 1996.  ABOVE LINE COMMENTED OUT.  NOTE THAT THERE ARE 2
CCCCC WAYS TO DEFINE HEIGHT FOR RELATIVE HISTOGRAM.  ONE WAY DEFINES
CCCCC THE AREA SO THAT THE AREA SUMS TO 1 (I.E., THE INTEGRAL) AS IN
CCCCC A PROBABILITY DENSITY FUNCTION.  THE OTHER WAY IS SO THAT THE
CCCCC THE HEIGHTS SUM TO 1, I.E., THE HEIGHT IS THE PERCENT OF THE
CCCCC TOTAL.  THE IRHSTG SWITCH NOW DETERMINES WHICH METHOD IS USED.
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM1=AN3
        ELSE
          DENOM1=AN3*DCLWID
        ENDIF
      ENDIF
C
      K=0
      DO3120J=1,NUMCLA
      K=K+1
      DJ=J
      DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
      FJ=C1(J)
      X9(K)=DCLMDJ
      Y9(K)=FJ/DENOM1
      D9(K)=1.0
 3120 CONTINUE
C
C               **********************************
C               **  STEP 32--                   **
C               **  DETERMINE PLOT COORDINATES  **
C               **  FOR RESPONSE VARIABLE 2     **
C               **********************************
C
      SUM2=0.0
      DO3210J=1,NUMCLA
      FJ=C2(J)
      SUM2=SUM2+FJ
 3210 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1995
      AN4=SUM2
C
      DENOM2=1.0
CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1995
CCCCC IF(IRELAT.EQ.'ON')DENOM2=SUM2
CCCCC IF(IRELAT.EQ.'ON')DENOM2=AN4*DCLWID
CCCCC MARCH 1996.  ABOVE LINE COMMENTED OUT.  NOTE THAT THERE ARE 2
CCCCC WAYS TO DEFINE HEIGHT FOR RELATIVE HISTOGRAM.  ONE WAY DEFINES
CCCCC THE AREA SO THAT THE AREA SUMS TO 1 (I.E., THE INTEGRAL) AS IN
CCCCC A PROBABILITY DENSITY FUNCTION.  THE OTHER WAY IS SO THAT THE
CCCCC THE HEIGHTS SUM TO 1, I.E., THE HEIGHT IS THE PERCENT OF THE
CCCCC TOTAL.  THE IRHSTG SWITCH NOW DETERMINES WHICH METHOD IS USED.
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM2=AN4
        ELSE
          DENOM2=AN4*DCLWID
        ENDIF
      ENDIF
C
C
      DO3220J=1,NUMCLA
      K=K+1
      DJ=J
      DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
      FJ=C2(J)
      X9(K)=DCLMDJ
      Y9(K)=(-FJ/DENOM2)
      D9(K)=2.0
 3220 CONTINUE
C
      N9=K
      NPLOTV=3
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBIH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IRELAT,IERROR
 9012 FORMAT('ICASPL,IRELAT,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)N1,N2
 9021 FORMAT('N1,N2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9023I=1,N1
      WRITE(ICOUT,9024)I,Y1(I)
 9024 FORMAT('I, Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9023 CONTINUE
      DO9025I=1,N2
      WRITE(ICOUT,9026)I,Y2(I)
 9026 FORMAT('I, Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9033)SUM1,DENOM1,SUM2,DENOM2
 9033 FORMAT('SUM1,DENOM1,SUM2,DENOM2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)N9
 9031 FORMAT('N9 = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N9
      WRITE(ICOUT,9036)I,Y9(I),X9(I),D9(I)
 9036 FORMAT('I,Y9(I),X9(I),D9(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
      WRITE(ICOUT,9037)DCLWID,DXSTAR,DXSTOP
 9037 FORMAT('DCLWID,DXSTAR,DXSTOP = ',3D15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBIN(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
CCCCC MARCH 2006: ADD FOLLOWING LINE TO ALLOW DIFFERENT
CCCCC             ALTERNATIVES TO BINNING
     1TEMP1,MAXNXT,IHSTCW,
     1Y2,X2,N2,IBUGG3,IERROR)
C
C     PURPOSE--BIN A VARIABLE Y INTO X2 Y2.
C              THAT IS CONVERT RAW DATA TO FREQUENCY DATA.
C              BINNING CAN BE EITHER TO COUNTS OR TO RELATIVE
C              FREQUENCY.
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/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT
C                                       CLASS WIDTH ALGORITHMS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
      CHARACTER*4 IRHSTG
      CHARACTER*4 IHSTCW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
 
      DOUBLE PRECISION DCLWID
      DOUBLE PRECISION DXSTAR
      DOUBLE PRECISION DXSTOP
      DOUBLE PRECISION DCLMNJ
      DOUBLE PRECISION DCLMDJ
      DOUBLE PRECISION DCLMXJ
      DOUBLE PRECISION DJ
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DABSDE
      DOUBLE PRECISION DTOTWI
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION TEMP1(*)
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='DPBI'
      ISUBN2='N   '
C
      IERROR='NO'
C
      K=(-999)
      DCLMDJ=(-999.0D0)
C
      KP3=0
C
      AN3=0.0
      DENOM=0.0
C
      DCLWID=CLWID
      DXSTAR=XSTART
      DXSTOP=XSTOP
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN BINNING DATA (DPBIN)--')
        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 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO60I=1,N
        IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)HOLD
   62 FORMAT('      ALL INPUT DATA ELEMENTS ARE IDENTICALLY EQUAL ',
     1       'TO ',G15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,70)
   70   FORMAT('***** AT THE BEGINNING OF DPBIN--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)IRELAT,IRHSTG,IHSTCW
   71   FORMAT('IRELAT,IRHSTG,IHSTCW = ',3(A4,1X))
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)N,CLWID,XSTART,XSTOP
   72   FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,N
          WRITE(ICOUT,74)I,Y(I)
   74     FORMAT('I, Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
C               **********************************************
C               **  STEP 2--                                **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
  110 CONTINUE
CCCCC IF(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND.
CCCCC1XSTOP.NE.CPUMAX)GOTO119
CCCCC IWRIT2='OFF'
CCCCC CALL MEAN(Y,N,IWRIT2,YMEAN,IBUGG3,IERROR)
CCCCC CALL SD(Y,N,IWRIT2,YSD,IBUGG3,IERROR)
CCCCC IF(CLWID.EQ.CPUMIN)DCLWID=0.3*YSD
CCCCC IF(XSTART.EQ.CPUMIN)DXSTAR=YMEAN-6.0*YSD
CCCCC IF(XSTOP.EQ.CPUMAX)DXSTOP=YMEAN+6.0*YSD
CC119 CONTINUE
C
C  MARCH 2006: ALLOW DIFFERENT DEFAULT BINNING ALGORITHMS (AS
C              SPECIFIED BY IHSTCW).
C
      IF(CLWID.EQ.CPUMIN.OR.XSTART.EQ.CPUMIN.OR.
     1  XSTOP.EQ.CPUMAX)THEN
        IWRIT2='OFF'
        CALL MEAN(Y,N,IWRIT2,XMEAN,IBUGG3,IERROR)
        CALL SD(Y,N,IWRIT2,XSD,IBUGG3,IERROR)
C
        IF(IHSTCW.EQ.'DEFA')THEN
          IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
        ELSEIF(IHSTCW.EQ.'NORM')THEN
          IF(CLWID.EQ.CPUMIN)DCLWID=3.5*XSD/(REAL(N)**(1./3.))
        ELSEIF(IHSTCW.EQ.'NCOR')THEN
          IF(CLWID.EQ.CPUMIN)THEN
            CALL STMOM3(Y,N,IWRIT2,XSKEW,IBUGG3,IERROR)
            CALL STMOM4(Y,N,IWRIT2,XKURT,IBUGG3,IERROR)
            TERM1=3.5*XSD/(REAL(N)**(1./3.))
            IF(XSKEW.GT.0.0 .AND. XSKEW.LT.3.0)THEN
              TERM2=1.0/(1.0 - 0.0060*XSKEW + 0.27*XSKEW**2 -
     1              0.0069*XSKEW**3)
            ELSE
              TERM2=1.0
            ENDIF
            XKURT=XKURT - 3.0
            IF(XKURT.GT.0.0 .AND. XKURT.LT.6.0)THEN
              TERM3=1.0 - 0.2*(1.0 - EXP(-0.7*XKURT))
            ELSE
              TERM3=1.0
            ENDIF
            DCLWID=DBLE(TERM1*TERM2*TERM3)
          ENDIF
        ELSEIF(IHSTCW.EQ.'IQ  ')THEN
          IF(CLWID.EQ.CPUMIN)THEN
            CALL LOWQUA(Y,N,IWRIT2,XTEMP1,MAXOBV,XLOWQ,
     1                  IBUGG3,IERROR)
            CALL UPPQUA(Y,N,IWRIT2,XTEMP1,MAXOBV,XUPPQ,
     1                  IBUGG3,IERROR)
            XIQ=XUPPQ - XLOWQ
            DCLWID=2.603*XIQ/(REAL(N)**(1./3.))
          ENDIF
        ELSE
          IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
        ENDIF
C
        IF(XSTART.EQ.CPUMIN)DXSTAR=XMEAN-6.0*XSD
        IF(XSTOP.EQ.CPUMAX)DXSTOP=XMEAN+6.0*XSD
      ENDIF
C
  180 CONTINUE
      DO181I=1,N
        X2(I)=0.0
        Y2(I)=0.0
  181 CONTINUE
      DTOTWI=DXSTOP-DXSTAR
      ANUMCL=DTOTWI/DCLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      DABSDE=DABS(DCLMXJ-DXSTOP)
      IF(DABSDE.LE.0.0001D0)NUMCLA=NUMCLA-1
C
C               *******************************************************
C               **  STEP 3--                                         **
C               **  DETERMINE THE FREQUENCY (COUNTS) FOR EACH CLASS  **
C               *******************************************************
C
  410 CONTINUE
      DO420I=1,N
      DXI=Y(I)
      DO430J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DXI.AND.DXI.LT.DCLMXJ)GOTO440
  430 CONTINUE
      GOTO420
  440 CONTINUE
      Y2(J2)=Y2(J2)+1.0
  420 CONTINUE
C
C     FOR THIS RAW DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C
      J=NUMCLA
      DO450I=1,N
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      DXI=Y(I)
      IF(DXI.EQ.DCLMXJ)Y2(J)=Y2(J)+1.0
  450 CONTINUE
C
  590 CONTINUE
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,591)
  591   FORMAT('***** IN THE MIDDLE    OF DPBIN--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,592)DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA
  592   FORMAT('DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA= ',
     1        4D11.4,F10.0,I8)
        CALL DPWRST('XXX','BUG ')
        DO593J=1,NUMCLA
          DJ=J
          DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
          DCLMXJ=DXSTAR+DJ*DCLWID
          IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
          FJ=Y2(J)
          WRITE(ICOUT,594)J,DCLMNJ,DCLMXJ,FJ
  594     FORMAT('J,DCLMNJ,DCLMXJ,FJ = ',I8,2D15.7,E15.7)
          CALL DPWRST('XXX','BUG ')
  593   CONTINUE
      ENDIF
C
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      FJ=Y2(J)
      SUM=SUM+FJ
 1110 CONTINUE
      AN3=SUM
C
      DENOM=1.0
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM=AN3
        ELSE
          DENOM=AN3*DCLWID
        ENDIF
      ENDIF
C
      DO1120J=1,NUMCLA
        K=J
        DJ=J
        DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
        FJ=Y2(J)
        X2(K)=DCLMDJ
        Y2(K)=FJ/DENOM
 1120 CONTINUE
      N2=K
C
      DO1130J=NUMCLA,1,-1
        IF(Y2(J).GT.0.0)THEN
          N2=J
          GOTO1139
        ENDIF
 1130 CONTINUE
      N2=1
 1139 CONTINUE
C
      DO1140J=1,N2
        IF(Y2(J).GT.0.0)THEN
          IFRST=J
          GOTO1149
        ENDIF
 1140 CONTINUE
      IFRST=1
 1149 CONTINUE
      K=0
      DO1150J=IFRST,N2
        K=K+1
        X2(K)=X2(J)
        Y2(K)=Y2(J)
 1150 CONTINUE
C
      IF(N2.LT.NUMCLA)THEN
        DO1160I=N2+1,NUMCLA
          Y2(I)=0.0
          X2(I)=0.0
 1160   CONTINUE
      ENDIF
      N2=K
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPBIN--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IRELAT,IERROR,N2
 9012   FORMAT('IRELAT,IERROR,N2 = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)AN3,DENOM
 9013   FORMAT('AN3,DENOM = ',E15.8,E15.8)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,N2
          WRITE(ICOUT,9016)I,X2(I),Y2(I)
 9016     FORMAT('I,X2(I),Y2(I) = ',I8,E15.7,F9.2)
          CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
        WRITE(ICOUT,9017)N,DCLWID,DXSTAR,DXSTOP
 9017   FORMAT('N,DCLWID,DXSTAR,DXSTOP = ',I6,3D15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPBINA(Y,N,CLWID,XSTART,XSTOP,M,
     1XTEMP1,MAXOBV,
     1IRELAT,IASHWT,IHSTCW,
     1Y2,X2,N2,IBUGG3,IERROR)
C
C     PURPOSE--COMPUTE HISTOGRAM BINS USING THE "AVERAGE SHIFTED
C              HISTOGRAM" (ASH) ALGORITHM DOCUMENTED BY DAVID SCOTT,
C              1992, "MULTIVARIATE DENSITY ESTIMATION: THEORY,
C              PRACTICE, AND VISUALIZATION", WILEY, CHAPTER 5.
C              WE IMPLEMENT THE ALGORITHMS BIN1 AND ASH1 GIVEN ON
C              PAGES 117-118.  THE BINNED DATA IS RETURNED IN
C              Y2 AND X2.
C
C              NOTE THAT SINCE THE ASH BINNING IS INTENDED TO BE A
C              SIMPLE DENSITY ESTIMATOR, THIS ALGORITHM IS
C              IMPLEMENTED FOR THE "RELATIVE FREQUENCY" CASE, NOT
C              RAW COUNTS.
C
C              THE BASIC IDEA IS:
C
C              1) GIVEN A CLASS WIDTH OF H
C              2) CHOOSE M WHERE WE CONSTRUCT A COLLECTION OF M
C                 HISTOGRAMS, EACH WITH A CLASS WIDTH OF H, BUT
C                 WITH START POINTS
C                 t0 = 0, h/m, 2*h/m, ... , (m-1)*h/m
C              3) THIS RESULTS IN A SMOOTHED HISTOGRAM WITH
C                 A BIN WIDTH OF DELTA=H/M.  HIGHER VALUES OF M
C                 RESULT IN A SMOOTHER ESTIMATE.  VALUES OF M ARE
C                 TYPICALLY IN THE RANGE 4 TO 32.  IN THIS
C                 SUBROUTINE, VALUES OF M < 1 ARE SET TO 1 AND
C                 VALUES OF M > 64 ARE SET TO 64.
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--2004/9
C     ORIGINAL VERSION--SEPTEMBER 2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      PARAMETER(MAXM=64)
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
      CHARACTER*4 IRELAT
      CHARACTER*4 IASHWT
      CHARACTER*4 IHSTCW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
 
      DOUBLE PRECISION DCLWID
      DOUBLE PRECISION DXSTAR
      DOUBLE PRECISION DXSTOP
      DOUBLE PRECISION DH
      DOUBLE PRECISION DELTA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DNBIN
      DOUBLE PRECISION DN
C
C-----------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION XTEMP1(*)
C
      DIMENSION WTM(2*MAXM)
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='DPBI'
      ISUBN2='N   '
C
      IERROR='NO'
C
      DCLWID=CLWID
      DXSTAR=XSTART
      DXSTOP=XSTOP
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.LE.5)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN AVERAGE SHIFTED HISTOGRAM BINNING--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 5;')
        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
      ENDIF
C
      IF(M.LT.1 .OR. M.GT.MAXM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,42)
   42   FORMAT('      THE VALUE OF THE M PARAMETER MUST BE AT ',
     1         'LEAST 1 AND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,44)MAXM
   44   FORMAT('      LESS THAN OR EQUAL TO ',I5,' (RECOMMENDED ',
     1         'VALUES ARE 4, 8, 16, OR 32).')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)M
   46   FORMAT('      THE ENTERED VALUE OF M HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO60I=1,N
        IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)HOLD
   62 FORMAT('      ALL INPUT OBSERVATIONS ARE IDENTICALLY EQUAL ',
     1       'TO ',G15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,70)
   70   FORMAT('***** AT THE BEGINNING OF DPBINA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)N,M,CLWID,XSTART,XSTOP
   71   FORMAT('N,M,CLWID,XSTART,XSTOP = ',2I6,3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)IASHWT
   72   FORMAT('IASHWT = ',A4)
        CALL DPWRST('XXX','BUG ')
        DO73I=1,N
          WRITE(ICOUT,74)I,Y(I)
   74     FORMAT('I, Y(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
   73   CONTINUE
      ENDIF
C
C               ***********************************
C               **  STEP 2--                     **
C               **  IF NECESSARY, DETERMINE:     **
C               **  1) CLASS WIDTH               **
C               **  2) START VALUE               **
C               **  3) STOP VALUE                **
C               **  4) NUMBER OF BINS            **
C               ***********************************
C
      IF(CLWID.EQ.CPUMIN.OR.XSTART.EQ.CPUMIN.OR.
     1XSTOP.EQ.CPUMAX)THEN
        IWRIT2='OFF'
        CALL MEAN(Y,N,IWRIT2,XMEAN,IBUGG3,IERROR)
        CALL SD(Y,N,IWRIT2,XSD,IBUGG3,IERROR)
        CALL MINIM(Y,N,IWRIT2,XMIN,IBUGG3,IERROR)
        CALL MAXIM(Y,N,IWRIT2,XMAX,IBUGG3,IERROR)
        IF(IHSTCW.EQ.'DEFA')THEN
          IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
        ELSEIF(IHSTCW.EQ.'NORM')THEN
          IF(CLWID.EQ.CPUMIN)DCLWID=3.5*XSD/(REAL(N)**(1./3.))
        ELSEIF(IHSTCW.EQ.'NCOR')THEN
          IF(CLWID.EQ.CPUMIN)THEN
            CALL STMOM3(Y,N,IWRIT2,XSKEW,IBUGG3,IERROR)
            CALL STMOM4(Y,N,IWRIT2,XKURT,IBUGG3,IERROR)
            TERM1=3.5*XSD/(REAL(N)**(1./3.))
            IF(XSKEW.GT.0.0 .AND. XSKEW.LT.3.0)THEN
              TERM2=1.0/(1.0 - 0.0060*XSKEW + 0.27*XSKEW**2 -
     1              0.0069*XSKEW**3)
            ELSE
              TERM2=1.0
            ENDIF
            XKURT=XKURT - 3.0
            IF(XKURT.GT.0.0 .AND. XKURT.LT.6.0)THEN
              TERM3=1.0 - 0.2*(1.0 - EXP(-0.7*XKURT))
            ELSE
              TERM3=1.0
            ENDIF
            DCLWID=DBLE(TERM1*TERM2*TERM3)
          ENDIF
        ELSEIF(IHSTCW.EQ.'IQ  ')THEN
          CALL LOWQUA(Y,N,IWRIT2,XTEMP1,MAXOBV,XLOWQ,IBUGG3,IERROR)
          CALL UPPQUA(Y,N,IWRIT2,XTEMP1,MAXOBV,XUPPQ,IBUGG3,IERROR)
          XIQ=XUPPQ - XLOWQ
          IF(CLWID.EQ.CPUMIN)DCLWID=2.603*XIQ/(REAL(N)**(1./3.))
        ELSE
          IF(CLWID.EQ.CPUMIN)DCLWID=0.3*XSD
        ENDIF
C
        IF(XSTART.EQ.CPUMIN)THEN
CCCCC     DXSTAR=XMEAN-6.0*XSD
          ABIN=ABS((XMEAN-XMIN)/REAL(DCLWID))
          IBINL=INT(ABIN+1.0)
          DXSTAR=DBLE(XMEAN)-DBLE(IBINL)*DCLWID
        ELSE
          ABIN=ABS((XMEAN-XSTART)/REAL(DCLWID))
          IBINL=INT(ABIN+1.0)
          DXSTAR=DBLE(XMEAN)-DBLE(IBINL)*DCLWID
        ENDIF
        IF(XSTOP.EQ.CPUMAX)THEN
CCCCCC    DXSTOP=XMEAN+6.0*XSD
          ABIN=ABS((XMAX-XMEAN)/REAL(DCLWID))
          IBINU=INT(ABIN+1.0)
          DXSTOP=DBLE(XMEAN)+DBLE(IBINU)*DCLWID
        ELSE
          ABIN=ABS((XSTOP-XMEAN)/REAL(DCLWID))
          IBINU=INT(ABIN+1.0)
          DXSTOP=DBLE(XMEAN)+DBLE(IBINU)*DCLWID
        ENDIF
        NBIN=IBINL + IBINU
      ELSE
        ABIN=(XMEAN-XSTART)/REAL(DCLWID)
        IBINL=INT(ABIN+1.0)
        DXSTAR=DBLE(XMEAN)-DBLE(IBINL)*DCLWID
C
        ABIN=(XSTOP-XMEAN)/REAL(DCLWID)
        IBINU=INT(ABIN+1.0)
        DXSTOP=DBLE(XMEAN)+DBLE(IBINU)*DCLWID
C
        NBIN=IBINL + IBINU
      ENDIF
C
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,170)
  170   FORMAT('***** MIDDLE OF DPBINA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,171)XMEAN,XSD,XMIN,XMAX
  171   FORMAT('XMEAN,XSD,XMIN,XMAX = ',4G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,172)DCLWID,DXSTAR,DXSTOP
  172   FORMAT('DCLWID,DXSTAR,DXSTOP = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  IMPLEMENT BIN1 ALGORITHM FROM PAGE 117.  **
C               ***********************************************
C
      DELTA=DCLWID/DBLE(M)
      NBIN=INT((DXSTOP-DXSTAR)/DELTA + 0.5D0)
      DNBIN=DBLE(NBIN)
      DO410I=1,NBIN
        Y2(I)=0.0
  410 CONTINUE
C
      DO420I=1,N
        DX=DBLE(Y(I))
        DK=((DX - DXSTAR)/DELTA) + 1.0D0
        IK=INT(DK)
        IF(IK.GE.1 .AND. IK.LE.NBIN)Y2(IK)=Y2(IK)+1.0
  420 CONTINUE
C
      IF(IRELAT.EQ.'OFF')THEN
        DO430I=1,NBIN
          X2(I)=REAL(DXSTAR + (DBLE(I)-0.5D0)*DELTA)
  430   CONTINUE
        N2=NBIN
        GOTO9000
      ENDIF
C
C               ***********************************************
C               **  STEP 4--                                 **
C               **  IMPLEMENT ASH1 ALGORITHM FROM PAGE 118.  **
C               ***********************************************
C
      IF(IASHWT.EQ.'BIWE')THEN
        ISTRT=1-M
        ISTOP=M-1
        ASUM=0.0
        DO510I=ISTRT,ISTOP
          T=REAL(I)/REAL(M)
          IF(-1.0.LE.T .AND. T.LE.1.0)THEN
            ASUM=ASUM + (15./16.)*(1.0-T**2)**2
          ENDIF
  510   CONTINUE
C
        DO520I=ISTRT,ISTOP
          T=REAL(I)/REAL(M)
          IF(-1.0.LE.T .AND. T.LE.1.0)THEN
            TERM1=(15./16.)*(1.0-T**2)**2
          ELSE
            TERM1=0.0
          ENDIF
          WTM(I+M+1)=REAL(M)*TERM1/ASUM
  520   CONTINUE
      ELSE
        ISTRT=1-M
        ISTOP=M-1
        DO560I=ISTRT,ISTOP
          WTM(I+M)=1.0 - ABS(REAL(I))/REAL(M)
  560   CONTINUE
      ENDIF
C
      DH=DBLE(M)*DELTA
      DO610I=1,NBIN
        XTEMP1(I)=0.0
  610 CONTINUE
C
      DO620K=1,NBIN
        IF(Y2(K).GT.0.0)THEN
          IFRST=MAX(1,K-M+1)
          ILAST=MIN(NBIN,K+M-1)
          IF(ILAST.GE.IFRST)THEN
            DO630I=IFRST,ILAST
              XTEMP1(I)= XTEMP1(I) + Y2(K)*WTM(I-K+M)
  630       CONTINUE
          ENDIF
        ENDIF
  620 CONTINUE
C
      DN=DBLE(N)
      DO680I=1,NBIN
        Y2(I)=XTEMP1(I)/(REAL(DH*DN))
        X2(I)=REAL(DXSTAR + (DBLE(I)-0.5D0)*DELTA)
  680 CONTINUE
      N2=NBIN
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPBINA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IRELAT,IERROR,N2
 9012   FORMAT('IRELAT,IERROR,N2 = ',A4,2X,A4,2X,I8)
        CALL DPWRST('XXX','BUG ')
        DO9015I=1,N2
          WRITE(ICOUT,9016)I,X2(I),Y2(I)
 9016     FORMAT('I,X2(I),Y2(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
 9015   CONTINUE
        DO9025I=1,M
          WRITE(ICOUT,9026)I,WTM(I)
 9026     FORMAT('I,WTM(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
 9025   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPBINI(Y,N,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1Y2,X2,N2,IBUGG3,IERROR)
C
C     PURPOSE--BIN A VARIABLE Y INTO X2 Y2.
C              THAT IS CONVERT RAW DATA TO FREQUENCY DATA.
C              BINNING IS TO COUNTS (AND NOT TO RELATIVE)
C              FREQUENCY.
C              THIS IS A SPECIFAL FORM OF BINNING WHERE THE
C              BINS ARE THE INTEGERS FROM THE MINIMUM TO THE MAXIMUM
C              VALUE.  THIS ROUTINE IS USED TO BIN FOR GOODNESS OF
C              FIT TESTS FOR DISCRETE DISTRIBUTIONS.
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--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IRELAT
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
      CHARACTER*4 IRHSTG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
 
      DOUBLE PRECISION DCLWID
      DOUBLE PRECISION DXSTAR
      DOUBLE PRECISION DXSTOP
      DOUBLE PRECISION DCLMNJ
      DOUBLE PRECISION DCLMDJ
      DOUBLE PRECISION DCLMXJ
      DOUBLE PRECISION DJ
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DABSDE
      DOUBLE PRECISION DTOTWI
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
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='DPBI'
      ISUBN2='NI  '
C
      IERROR='NO'
C
      K=(-999)
      DCLMDJ=(-999.0D0)
C
      KP3=0
C
      AN3=0.0
      DENOM=0.0
C
      DCLWID=CLWID
      DXSTAR=XSTART
      DXSTOP=XSTOP
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 DPBINI--')
      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 DPBINI--')
      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=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 DPBINI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT AXIS 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(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPBINI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N,CLWID,XSTART,XSTOP
   72 FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y(I)
   74 FORMAT('I, Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               **********************************************
C               **  STEP 2--                                **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
  110 CONTINUE
      IF(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND.
     1XSTOP.NE.CPUMAX)GOTO119
      IWRIT2='OFF'
      CALL MINIM(Y,N,IWRIT2,YMIN,IBUGG3,IERROR)
      CALL MAXIM(Y,N,IWRIT2,YMAX,IBUGG3,IERROR)
      IF(CLWID.EQ.CPUMIN)DCLWID=1.0
      IF(XSTART.EQ.CPUMIN)DXSTAR=REAL(INT(YMIN+0.5))-0.5
      IF(XSTOP.EQ.CPUMAX)DXSTOP=REAL(INT(YMAX+0.5))+0.5
  119 CONTINUE
C
  180 CONTINUE
      DO181I=1,N
        X2(I)=0.0
        Y2(I)=0.0
  181 CONTINUE
      DTOTWI=DXSTOP-DXSTAR
      ANUMCL=DTOTWI/DCLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      DABSDE=DABS(DCLMXJ-DXSTOP)
      IF(DABSDE.LE.0.0001D0)NUMCLA=NUMCLA-1
C
C               *******************************************************
C               **  STEP 3--                                         **
C               **  DETERMINE THE FREQUENCY (COUNTS) FOR EACH CLASS  **
C               *******************************************************
C
  410 CONTINUE
      DO420I=1,N
      DXI=Y(I)
      DO430J=1,NUMCLA
      J2=J
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      IF(DCLMNJ.LE.DXI.AND.DXI.LT.DCLMXJ)GOTO440
  430 CONTINUE
      GOTO420
  440 CONTINUE
      Y2(J2)=Y2(J2)+1.0
  420 CONTINUE
C
C     FOR THIS RAW DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C
      J=NUMCLA
      DO450I=1,N
      DJ=J
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      DXI=Y(I)
      IF(DXI.EQ.DCLMXJ)Y2(J)=Y2(J)+1.0
  450 CONTINUE
C
  590 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO595
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,591)
  591 FORMAT('***** IN THE MIDDLE    OF DPBINI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,592)DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA
  592 FORMAT('DCLWID,DXSTAR,DXSTOP,DTOTWI,ANUMCL,NUMCLA= ',
     14D11.4,F10.0,I8)
      CALL DPWRST('XXX','BUG ')
      DO593J=1,NUMCLA
      DJ=J
      DCLMNJ=DXSTAR+(DJ-1.0D0)*DCLWID
      DCLMXJ=DXSTAR+DJ*DCLWID
      IF(DCLMXJ.GT.DXSTOP)DCLMXJ=DXSTOP
      FJ=Y2(J)
      WRITE(ICOUT,594)J,DCLMNJ,DCLMXJ,FJ
  594 FORMAT('J,DCLMNJ,DCLMXJ,FJ = ',I8,2D15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
  593 CONTINUE
  595 CONTINUE
C
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      FJ=Y2(J)
      SUM=SUM+FJ
 1110 CONTINUE
      AN3=SUM
C
      DENOM=1.0
C
      IF(IRELAT.EQ.'ON')THEN
        IF(IRHSTG.EQ.'PERC')THEN
          DENOM=AN3
        ELSE
          DENOM=AN3*DCLWID
        ENDIF
      ENDIF
C
      DO1120J=1,NUMCLA
        K=J
        DJ=J
        DCLMDJ=DXSTAR+(DJ-0.5D0)*DCLWID
        X2(K)=REAL(DCLMDJ)
        FJ=Y2(K)
        Y2(K)=FJ/DENOM
 1120 CONTINUE
      N2=K
C
      DO1130J=NUMCLA,1,-1
        IF(Y2(J).GT.0.0)THEN
          N2=J
          GOTO1139
        ENDIF
 1130 CONTINUE
      N2=1
 1139 CONTINUE
C
      DO1140J=1,N2
        IF(Y2(J).GT.0.0)THEN
          IFRST=J
          GOTO1149
        ENDIF
 1140 CONTINUE
      IFRST=1
 1149 CONTINUE
      K=0
      DO1150J=IFRST,N2
        K=K+1
        X2(K)=X2(J)
        Y2(K)=Y2(J)
 1150 CONTINUE
C
      IF(N2.LT.NUMCLA)THEN
        DO1160I=N2+1,NUMCLA
          Y2(I)=0.0
          X2(I)=0.0
 1160   CONTINUE
      ENDIF
      N2=K
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBINI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IRELAT,IERROR,N2
 9012 FORMAT('IRELAT,IERROR,N2 = ',A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)AN3,DENOM
 9013 FORMAT('AN3,DENOM = ',E15.8,E15.8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,X2(I),Y2(I)
 9016 FORMAT('I,X2(I),Y2(I) = ',I8,E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)N,DCLWID,DXSTAR,DXSTOP
 9017 FORMAT('N,DCLWID,DXSTAR,DXSTOP = ',I6,3D15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBKCL(IHARG,NUMARG,IDBKCO,IBKPCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D BACKPLANE.
C              THE COLOR FOR THE BACKPLANE WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBKPCO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBKCO
C     OUTPUT ARGUMENTS--IBKPCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BACKPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBKCO
      CHARACTER*4 IBKPCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IBKPCO=IDBKCO
      GOTO1180
C
 1160 CONTINUE
      IBKPCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBKPCO
 1181 FORMAT('THE (3-D) BACKPLANE COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBKGC(IHARG,NUMARG,IDBKGC,IBKPGC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D BACKPLANE GRID.
C              THE COLOR FOR THE BACKPLANE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBKPGC.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBKGC
C     OUTPUT ARGUMENTS--IBKPGC
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BACKPLANE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBKGC
      CHARACTER*4 IBKPGC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IBKPGC=IDBKGC
      GOTO1180
C
 1160 CONTINUE
      IBKPGC=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBKPGC
 1181 FORMAT('THE (3-D) BACKPLANE GRID COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBKGP(IHARG,NUMARG,IDBKGP,IBKPGP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR THE 3-D BACKPLANE GRID.
C              THE PATTERN FOR THE BACKPLANE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBKPGP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBKGP
C     OUTPUT ARGUMENTS--IBKPGP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BACKPLANE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBKGP
      CHARACTER*4 IBKPGP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1160
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1150 CONTINUE
      IBKPGP='SOLI'
      GOTO1180
C
 1160 CONTINUE
      IBKPGP='BLAN'
      GOTO1180
C
 1170 CONTINUE
      IBKPGP=IDBKGP
      GOTO1180
C
 1175 CONTINUE
      IBKPGP=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBKPGP
 1181 FORMAT('THE (3-D) BACKPLANE GRID PATTERN ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBKGR(IHARG,NUMARG,IDBKGR,IBKPGR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D BACKPLANE GRID SWITCH IBKPGR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDBKGR
C     OUTPUT ARGUMENTS--IBKPGR   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BACKPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBKGR
      CHARACTER*4 IBKPGR
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1199
C
 1150 CONTINUE
      IBKPGR='ON'
      GOTO1180
C
 1160 CONTINUE
      IBKPGR='OFF'
      GOTO1180
C
 1170 CONTINUE
      IBKPGR=IDBKGR
      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)IBKPGR
 1181 FORMAT('THE (3-D) BACKPLANE GRID SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBKP(IHARG,NUMARG,IBKPSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D BACKPLANE SWITCH IBKPSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IBKPSW   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BACKPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IBKPSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IBKPSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IBKPSW='OFF'
      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)IBKPSW
 1181 FORMAT('THE (3-D) BACKPLANE SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBLOC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST
CCCCC1BARHEF,BARWEF,
     1BARHEF,BARWEF,MAXNXT,
     1ISEED,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A BLOCK PLOT
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 NATIONAL INSTITUTE OF STANDARDS & TECHNOLOGY
C                 GAITHERSBURG, MARYLAND 20899
C                 PHONE--301-975-2855
C     ORIGINAL VERSION--MAY     1992.
C     UPDATED         --MARCH   1995.  MAD AND AAD PLOTS
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     SYNTAX FOR COMMAND (MUST HAVE 3 OR MORE ARGUMENTS)--
C           BLOCK PLOT Y <SEQ. OF VAR. DEFINING HOR. AXIS> CHAR-VAR.
C     EXAMPLES--
C           BLOCK PLOT Y BOY MAT
C           BLOCK PLOT Y X1 X2  MAD AND AAD PLOTS
C           BLOCK PLOT Y CONC QUENCH OVEN
C           BLOCK PLOT Y    X2 X3    X1
C           BLOCK PLOT Y    X2 X3 X4 X5 X6 X7    X1
C     NOTE--MAX NUMBER OF NUISANCE FACTORS = 20
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     1992.
C     UPDATED         --MARCH     2002. ADD ROBUSTNESS PLOT AS
C                                       SYNONYM FOR BLOCK PLOT
C     UPDATED         --AUGUST    2002. USE "CMPSTA" TO COMPUTE
C                                       STATISTICS, EXPAND LIST OF
C                                       SUPPORTED STATISTICS
C     UPDATED         --APRIL     2003. ADD SN AND QN (ROBUST SCALE
C                                       STATISTICS)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHVERT
      CHARACTER*4 IHVER2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHSUB
      CHARACTER*4 IHSUB2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION TAG(MAXOBV)
      DIMENSION TEMP(MAXOBV)
C
      DIMENSION DIST(1000)
      DIMENSION ITABLE(21)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(1))
      EQUIVALENCE (GARBAG(IGARB3),TAG(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(1))
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
      IERROR='NO'
C
      ISUBN1='DPBL'
      ISUBN2='OC  '
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
      ICOLH=0
C
C               *********************************
C               **  TREAT THE BLOCK PLOT CASE  **
C               *********************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2,ISUBRO
   52 FORMAT('ICASPL,IAND1,IAND2,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)BARHEF,BARWEF
   54 FORMAT('BARHEF,BARWEF = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC MORE WORK (FOR OTHER STAT) NEEDS TO BE DONE HERE...
C
      ICASPL='RAW '
      IFOUND='YES'
      IF(ICOM.EQ.'BLOC'.OR.ICOM.EQ.'ROBU')THEN
         ICASPL='RAW '
         CALL ADJUST(1,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'NUMB'.OR.ICOM.EQ.'SIZE'.OR.ICOM.EQ.'COUN')THEN
         ICASPL='NUMB'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'AAD ')THEN
         ICASPL='AAD '
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')THEN
         ICASPL='AAD '
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MEAN' .OR. ICOM.EQ.'AVER')THEN
         ICASPL='MEAN'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MAD ')THEN
         ICASPL='MAD '
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MEDI'.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')THEN
         ICASPL='MAD '
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MEDI')THEN
         ICASPL='MEDI'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MIDR')THEN
         ICASPL='MIDR'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MIDM')THEN
         ICASPL='MIDM'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1        IHARG(2).EQ.'OF'.AND.IHARG(3).EQ.'THE'.AND.
     1        IHARG(4).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(6,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1        IHARG(2).EQ.'OF'.AND.IHARG(3).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1        IHARG(2).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SD'.AND.IHARG(1).EQ.'OF'.AND.
     1        IHARG(2).EQ.'THE'.AND.IHARG(3).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SD'.AND.IHARG(1).EQ.'OF'.AND.
     1        IHARG(2).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SD'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='SDME'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI')THEN
         ICASPL='SD  '
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SD  ')THEN
         ICASPL='SD  '
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF'.AND.
     1        IHARG(2).EQ.'THE'.AND.IHARG(3).EQ.'MEAN')THEN
         ICASPL='VAME'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF'.AND.
     1        IHARG(2).EQ.'MEAN')THEN
         ICASPL='VAME'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='VAME'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'VARI')THEN
         ICASPL='VARI'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'SD')THEN
         ICASPL='RESD'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'STAN'.AND.
     1        IHARG(2).EQ.'DEVI')THEN
         ICASPL='RESD'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VARI')THEN
         ICASPL='REVA'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'OF'.AND.
     1        IHARG(2).EQ.'VARI')THEN
         ICASPL='CVAR'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'VARI')THEN
         ICASPL='CVAR'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'RANG')THEN
         ICASPL='RANG'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MINI')THEN
         ICASPL='MINI'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'MAXI')THEN
         ICASPL='MAXI'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'EXTR')THEN
         ICASPL='EXTR'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'QUAR')THEN
         ICASPL='LOWQ'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'QUAR')THEN
         ICASPL='UPPQ'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'HING')THEN
         ICASPL='LOWH'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'HING')THEN
         ICASPL='UPPH'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='1DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='2DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='3DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='4DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='5DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='6DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='7DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='8DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DECI')THEN
         ICASPL='9DEC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SKEW')THEN
         ICASPL='SKEW'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'THIR'.AND.
     1        IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')THEN
         ICASPL='SKEW'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'KURT')THEN
         ICASPL='KURT'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'FOUR'.AND.
     1        IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')THEN
         ICASPL='KURT'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR')THEN
         ICASPL='AUCR'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COVA')THEN
         ICASPL='AUCV'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SN  '.AND.IHARG(1).EQ.'SCAL')THEN
         ICASPL='SNSC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'QN  '.AND.IHARG(1).EQ.'SCAL')THEN
         ICASPL='QNSC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SN0')THEN
         ICASPL='SN0'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SN+')THEN
         ICASPL='SN+'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SN-')THEN
         ICASPL='SN-'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'SN00')THEN
         ICASPL='SN00'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF((ICOM.EQ.'SIN'.OR.ICOM.EQ.'SINE').AND.
     1        IHARG(1).EQ.'FREQ')THEN
         ICASPL='SIFR'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF((ICOM.EQ.'SIN'.OR.ICOM.EQ.'SINE').AND.
     1        IHARG(1).EQ.'AMPL')THEN
         ICASPL='SIAM'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CP')THEN
         ICASPL='CP'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CPK')THEN
         ICASPL='CPK'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CNPK')THEN
         ICASPL='CNPK'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CPM')THEN
         ICASPL='CPM'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CPL')THEN
         ICASPL='CPL'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CPU')THEN
         ICASPL='CPU'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'CC')THEN
         ICASPL='CC'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'DEFE')THEN
         ICASPL='PEDE'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'EXPE'.AND.IHARG(1).EQ.'LOSS')THEN
         ICASPL='EXLO'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'NORM'.AND.IHARG(1).EQ.'PPCC')THEN
         ICASPL='NOPP'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.
     1        IHARG(2).EQ.'MIDV')THEN
         ICASPL='PBMV'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'PERC')THEN
         ICASPL='PERC'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'QUAN'.AND.IHARG(1).EQ.'STAN'.AND.
     1        IHARG(2).EQ.'ERRO')THEN
         ICASPL='QUSE'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'QUAN')THEN
         ICASPL='QUAN'
         CALL ADJUST(2,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1        IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'ERRO')THEN
         ICASPL='TMSE'
         CALL ADJUST(5,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='TRIM'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='WINM'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'VARI')THEN
         ICASPL='WIVA'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'SD')THEN
         ICASPL='WISD'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'STAN'.AND.
     1        IHARG(2).EQ.'DEVI')THEN
         ICASPL='WISD'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'GEOM'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='GEME'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'GEOM'.AND.IHARG(1).EQ.'SD')THEN
         ICASPL='GESD'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'GEOM'.AND.IHARG(1).EQ.'STAN'.AND.
     1        IHARG(2).EQ.'DEVI')THEN
         ICASPL='GESD'
         CALL ADJUST(4,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'HARM'.AND.IHARG(1).EQ.'MEAN')THEN
         ICASPL='HAME'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'INTE'.AND.IHARG(1).EQ.'RANG')THEN
         ICASPL='IQRA'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'LOCA')THEN
         ICASPL='BILO'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'SCAL')THEN
         ICASPL='BISC'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDV')THEN
         ICASPL='BIMV'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE IF(ICOM.EQ.'HODG'.AND.IHARG(1).EQ.'LEHM')THEN
         ICASPL='HLEH'
         CALL ADJUST(3,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE
         IFOUND='NO'
         GOTO9000
      ENDIF
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=3
      MAXNA=22
      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 VERT. AXIS VARIABLE)**
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHVERT=IHARG(1)
      IHVER2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVERT,IHVER2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV=IVALUE(ILOCV)
      NVERT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHVERT,ICOLV,NVERT
  211 FORMAT('IHVERT,ICOLV,NVERT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NVERT)      **
C               **  FOR THE VERT. AXIS VARIABLE IS 2 OR LARGER.              **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NVERT.GE.MINN2)GOTO390
      IBRANCH=310
      CALL MEBLOC(ISUBN1,ISUBN2,IBRANCH,MINN2,IANS,IWIDTH,
     1NUMARG,NUMV2,IHVERT,NVERT,IHHOR,NHOR)
      IERROR='YES'
      GOTO9000
  390 CONTINUE
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(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.1)THEN
         IBRANCH=400
         CALL MEBLOC(ISUBN1,ISUBN2,IBRANCH,MINN2,IANS,IWIDTH,
     1   NUMARG,NUMV2,IHVERT,NVERT,IHHOR,NHOR)
         IERROR='YES'
         GOTO9000
      ENDIF
C
      DO400J=1,NUMARG
         IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
            ICASEQ='SUBS'
            ILOCQ=J
            GOTO490
         ENDIF
         IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
            ICASEQ='EXCE'
            ILOCQ=J
            GOTO490
         ENDIF
         IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
            ICASEQ='FOR'
            ILOCQ=J
            GOTO490
         ENDIF
  400 CONTINUE
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      GOTO490
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')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 5--                                      **
C               **  THE TOTAL NUMBER OF VARIABLES (INCLUDING Y)   **
C               **  MUST BE AT LEAST 3,                           **
C               **  AND MAY BE OPTIONALLY MORE.                   **
C               **  THESE OTHER VALUES                            **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                 **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.        **
C               **  CHECK THE VALIDITY OF ALL REMAINING VARIABLES **
C               **  (NUISANCE + PRIMARY)                          **
C               ****************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.LE.2)THEN
         IBRANCH=510
         CALL MEBLOC(ISUBN1,ISUBN2,IBRANCH,MINN2,IANS,IWIDTH,
     1   NUMARG,NUMV2,IHVERT,NVERT,IHHOR,NHOR)
         IERROR='YES'
         GOTO9000
      ENDIF
C
      DO540K=2,NUMV2
         IHHOR=IHARG(K)
         IHHOR2=IHARG2(K)
         IHWUSE='V'
         MESSAG='YES'
         CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1   IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1   ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCH,IERROR)
         IF(IERROR.EQ.'YES')GOTO9000
         ICOLH=IVALUE(ILOCH)
         ITABLE(K)=ICOLH
         NHOR=IN(ILOCH)
         IF(IBUGG2.EQ.'ON')WRITE(ICOUT,541)K,IHHOR,ICOLH,NHOR
  541    FORMAT('K,IHHOR,ICOLH,NHOR   = ',I8,2X,A4,I8,I8)
         IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
         IF(NHOR.NE.NVERT)THEN
            IBRANCH=540
            CALL MEBLOC(ISUBN1,ISUBN2,IBRANCH,MINN2,IANS,IWIDTH,
     1      NUMARG,NUMV2,IHVERT,NVERT,IHHOR,NHOR)
            IERROR='YES'
            GOTO9000
         ENDIF
  540 CONTINUE
C
      IHSUB=IHARG(NUMV2)
      IHSUB2=IHARG2(NUMV2)
      ICOLT=IVALUE(ILOCH)
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE VERT. AXIS VARIABLE          **
C               **  AND THE TAG VARIABLE                       **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NVERT
         ISUB(I)=1
  615 CONTINUE
      NQ=NVERT
      GOTO650
C
  620 CONTINUE
      NIOLD=NVERT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NVERT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
C     *****EXTRACT THE VERTICAL AXIS VARIABLE*****
C
  650 CONTINUE
      IMAX=NVERT
      IF(NQ.LT.NVERT)IMAX=NQ
      J=0
      DO660I=1,IMAX
         IF(ISUB(I).EQ.1)THEN
            J=J+1
            IJ=MAXN*(ICOLV-1)+I
            IF(ICOLV.LE.MAXCOL)Y1(J)=V(IJ)
            IF(ICOLV.EQ.MAXCP1)Y1(J)=PRED(I)
            IF(ICOLV.EQ.MAXCP2)Y1(J)=RES(I)
            IF(ICOLV.EQ.MAXCP3)Y1(J)=YPLOT(I)
            IF(ICOLV.EQ.MAXCP4)Y1(J)=XPLOT(I)
            IF(ICOLV.EQ.MAXCP5)Y1(J)=X2PLOT(I)
            IF(ICOLV.EQ.MAXCP6)Y1(J)=TAGPLO(I)
         ENDIF
  660 CONTINUE
      NLOCAL=J
C
C     *****EXTRACT THE TAG VARIABLE*****
C
      J=0
      DO670I=1,IMAX
         IF(ISUB(I).EQ.1)THEN
            J=J+1
            IJ=MAXN*(ICOLT-1)+I
            IF(ICOLT.LE.MAXCOL)TAG(J)=V(IJ)
            IF(ICOLT.EQ.MAXCP1)TAG(J)=PRED(I)
            IF(ICOLT.EQ.MAXCP2)TAG(J)=RES(I)
            IF(ICOLT.EQ.MAXCP3)TAG(J)=YPLOT(I)
            IF(ICOLT.EQ.MAXCP4)TAG(J)=XPLOT(I)
            IF(ICOLT.EQ.MAXCP5)TAG(J)=X2PLOT(I)
            IF(ICOLT.EQ.MAXCP6)TAG(J)=TAGPLO(I)
         ENDIF
  670 CONTINUE
C
C     *****FORM THE HORIZONTAL AXIS VARIABLE*****
C     *****BY COMBINING ALL NUISANCE AXIS VARIABLES*****
C
      SHRINK=0.20
      NUMV2M=NUMV2-1
      DO680K=2,NUMV2M
C
         IF(K.GE.3)THEN
            CALL DISTIN(X1,NLOCAL,'OFF ',DIST,NDIST,IBUGG3,IERROR)
            CALL SORT(DIST,NDIST,DIST)
            DELMIN=CPUMAX
            NDISTM=NDIST-1
            DO682I=1,NDISTM
               IP1=I+1
               DEL=DIST(IP1)-DIST(I)
               IF(DEL.LT.DELMIN)DELMIN=DEL
  682       CONTINUE
         ENDIF
C
         ICOLH=ITABLE(K)
         J=0
         DO684I=1,IMAX
            IF(ISUB(I).EQ.1)THEN
               J=J+1
               IJ=MAXN*(ICOLH-1)+I
               IF(ICOLH.LE.MAXCOL)TEMP(J)=V(IJ)
               IF(ICOLH.EQ.MAXCP1)TEMP(J)=PRED(I)
               IF(ICOLH.EQ.MAXCP2)TEMP(J)=RES(I)
               IF(ICOLH.EQ.MAXCP3)TEMP(J)=YPLOT(I)
               IF(ICOLH.EQ.MAXCP4)TEMP(J)=XPLOT(I)
               IF(ICOLH.EQ.MAXCP5)TEMP(J)=X2PLOT(I)
               IF(ICOLH.EQ.MAXCP6)TEMP(J)=TAGPLO(I)
            ENDIF
  684    CONTINUE
C
         IF(K.EQ.2)THEN
            DO686I=1,NLOCAL
               X1(I)=TEMP(I)
  686       CONTINUE
         ENDIF
C
         IF(K.GE.3)THEN
            CALL MINIM(TEMP,NLOCAL,'OFF ',XMIN,IBUGG3,IERROR)
            CALL MAXIM(TEMP,NLOCAL,'OFF ',XMAX,IBUGG3,IERROR)
            DENOM=XMAX-XMIN
            IF(IBUGG2.EQ.'ON')WRITE(ICOUT,687)K,DENOM,DELMIN,SHRINK
  687       FORMAT('K,DENOM,DELMIN,SHRINK = ',I8,3E15.7)
            IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
            DO688I=1,NLOCAL
               TEMP(I)=2.0*((TEMP(I)-XMIN)/DENOM)-1.0
               TEMP(I)=TEMP(I)*DELMIN
               TEMP(I)=TEMP(I)*SHRINK
               X1(I)=X1(I)+TEMP(I)
  688       CONTINUE
         ENDIF
  680 CONTINUE
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  COMPUTE THE APPROPRIATE BLOCK PLOT
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               **  FORM THE PLOTTED VALUE AND THE SURROUNDING BAR.
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPBLO2(Y1,X1,TAG,NLOCAL,ICASPL,
     1TEMP,
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST.
CCCCC1BARHEF,BARWEF,
     1BARHEF,BARWEF,MAXNXT,
     1ISEED,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               **************************************************
C               **  STEP 9--                                    **
C               **  REDEFINE ICASPL FOR USE                     **
C               **  IN THE    PLOTGE   SUBROUTINE               **
C               **************************************************
C
      ICASPL='BLPL'
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 DPBLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,ISUBRO,IERROR
 9012 FORMAT('IFOUND,ISUBRO,IERROR = ',A4,2X,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)BARHEF,BARWEF
 9014 FORMAT('BARHEF,BARWEF = ',2E15.7)
      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 DPBLO2(Y,X,TAG,N,ICASPL,
     1DIST,
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST
     1BARHEF,BARWEF,MAXNXT,
     1ISEED,
     1Y3,X3,D3,N3,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A BLOCK PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 NATIONAL INSTITUTE OF STANDARDS & TECHNOLOGY
C                 GAITHERSBURG, MARYLAND 20899
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     ORIGINAL VERSION--MAY     1992.
C     UPDATED         --MARCH   1995.  MAXNXT TO ARGUMENT LIST
C     UPDATED         --JUNE    1995. FIX VERTICES JUNK
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION TAG(*)
C
      DIMENSION Y3(*)
      DIMENSION X3(*)
      DIMENSION D3(*)
C
      DIMENSION DIST(*)
C
      DIMENSION Y2(1000)
      DIMENSION X2(1000)
      DIMENSION TAG2(1000)
C
      DIMENSION DTAG(1000)
      DIMENSION DTAG2(1000)
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
      CHARACTER*4 IFOUNN
C
      EXTERNAL RANGE
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='DPBL'
      ISUBN2='O2  '
C
      XWIDTH=0.0
      XWIDT2=0.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 DPBLO2--')
      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 DPBLO2--')
      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
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BLO2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPBLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ISUBRO
   53 FORMAT('ICASPL,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)BARHEF,BARWEF
   54 FORMAT('BARHEF,BARWEF = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N
   71 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,N
      WRITE(ICOUT,76)I,Y(I),X(I),TAG(I)
   76 FORMAT('I, Y(I), X(I),TAG(I) = ',I8,3F15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 11--                                         **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR VARIABLE 2 (THE HOR. AXIS VARIABLE).          **
C               ********************************************************
C
      ISTEPN='11'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'BLO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DISTIN(X,N,'OFF ',DIST,NDIST,IBUGG3,IERROR)
      CALL SORT(DIST,NDIST,DIST)
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  IF NO STATISTIC IS CALLED FOR,              **
C               **  CARRY OVER THE RAW DATA INTO Y2,X2,TAG2,N2. **
C               **  IF A STATISTIC IS CALLED FOR,               **
C               **  COMPUTE THE STATISTICS AND COPY IT INTO Y2,X**2,TAG2,N2.
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'BLO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPBLO3(Y,X,TAG,N,ICASPL,DIST,NDIST,
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST.
     1MAXNXT,
     1ISEED,
     1Y2,X2,TAG2,N2,IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 13--                        **
C               **  COMPUTE 'COIN' PROBABILITY       **
C               **  FOR OBSERVED PATTERN.            **
C               **  UPDATE INTERNAL DATAPLOT ARRAYS  **
C               ***************************************
C
      CALL DISTIN(TAG2,N2,'OFF ',DTAG2,NDTAG2,IBUGG3,IERROR)
      FACES=NDTAG2
      PROB=1.0/FACES
C
      CALL HEADS(Y2,X2,TAG2,N2,
     1DIST,DTAG,
     1HEADS2,NTRIAL,AVEDEL,SDAVED,IBUGG3,ISUBRO,IERROR)
      HEADS3=HEADS2-1.0
      TRIALS=NTRIAL
C
      CALL BINCDF(HEADS3,PROB,NTRIAL,CDF)
      TAILPR=1.0-CDF
C
      CALL UPDATP('HEAD','S   ',HEADS2,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      CALL UPDATP('TRIA','LS  ',TRIALS,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      CALL UPDATP('FACE','S   ',FACES,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      CALL UPDATP('TAIL','PROB',TAILPR,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      CALL UPDATP('AVED','EL  ',AVEDEL,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      CALL UPDATP('SDAV','EDEL',SDAVED,'CHAD','NO  ',
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,ILOCN,IFOUNN,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************************
C               **  STEP 20--FORM PLOT COORDINATES                 **
C               **           BASED ON THE TAG VARIABLE (VAR.3).    **
C               **           THIS WILL BE A STRAIGHT COPY.         **
C               **           THIS WILL YIELD THE CHARACTERS PORTION**
C               **           OF THE FINAL PLOT.                    **
C               *****************************************************
C
      DO1100I=1,N2
         Y3(I)=Y2(I)
         X3(I)=X2(I)
         D3(I)=TAG2(I)
 1100 CONTINUE
      J=N2
C
      TAGMAX=CPUMIN
      DO1200I=1,N2
         IF(TAG2(I).GT.TAGMAX)TAGMAX=TAG2(I)
 1200 CONTINUE
CCCCC THE FOLLOWING LINE WAS CORRECTED               JUNE 1995
CCCCC DUE TO EXTRANEOUS CHARACTERS ON THE VERTICES   JUNE 1995
CCCCC OF CHARLES HAGWOOD BLOCK PLOTS                 JUNE 1995
CCCCC JD=TAGMAX+0.5
      JD=100
C
C               *****************************************************
C               **  STEP 21--FORM PLOT COORDINATES                 **
C               **           BASED ON THE HOR. AXIS VAR. (VAR. 2)  **
C               **           THIS WILL YIELD THE BOXES PORTION     **
C               **           OF THE FINAL PLOT.                    **
C               *****************************************************
C
C               ***********************************
C               **  STEP 23--                    **
C               **  COMPUTE MINIMUM CLASS WIDTH  **
C               ***********************************
C
      ISTEPN='23'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'BLO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NDIST.EQ.1)THEN
         XWIDTH=0.10*DIST(1)
      ENDIF
C
      IF(NDIST.GE.2)THEN
         XWIDTH=CPUMAX
         IMAX=NDIST-1
         DO2300I=1,IMAX
            IP1=I+1
            XWIDT2=DIST(IP1)-DIST(I)
            IF(XWIDT2.LT.XWIDTH)XWIDTH=XWIDT2
 2300    CONTINUE
      ENDIF
      BARHAW=XWIDTH/3.0
      BARHAW=BARWEF*BARHAW
C
C     COMPUTE RANGE OF VERTICAL AXIS DATA
C
      CALL RANGE(Y2,N2,'OFF ',Y2RANG,IBUGG3,IERROR)
      Y2GAP=0.04*Y2RANG
      Y2GAP=BARHEF*Y2GAP
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  LOOP THROUGH EACH DISTINCT HOR. AXIS VALUE. **
C               **  FOR A GIVEN HORIZONTAL AXIS VALUE--         **
C               **     FIND THE VERTICAL AXIS MINIMUM;          **
C               **     FIND THE VERTICAL AXIS MAXIMUM;          **
C               **     FORM PLOT COORDINATES OF THE BOX.        **
C               **************************************************
C
      ISTEPN='24'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'BLO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2400ISET=1,NDIST
C
         Y2MIN=CPUMAX
         Y2MAX=CPUMIN
         DO2410I=1,N2
            IF(X2(I).EQ.DIST(ISET))THEN
               IF(Y2(I).LT.Y2MIN)Y2MIN=Y2(I)
               IF(Y2(I).GT.Y2MAX)Y2MAX=Y2(I)
            ENDIF
 2410    CONTINUE
         Y2MING=Y2MIN-Y2GAP
         Y2MAXG=Y2MAX+Y2GAP
C
         JD=JD+1
         J=J+1
         X3(J)=DIST(ISET)-BARHAW
         Y3(J)=Y2MING
         D3(J)=JD
         J=J+1
         X3(J)=DIST(ISET)+BARHAW
         Y3(J)=Y2MING
         D3(J)=JD
C
         JD=JD+1
         J=J+1
         X3(J)=DIST(ISET)+BARHAW
         Y3(J)=Y2MING
         D3(J)=JD
         J=J+1
         X3(J)=DIST(ISET)+BARHAW
         Y3(J)=Y2MAXG
         D3(J)=JD
C
         JD=JD+1
         J=J+1
         X3(J)=DIST(ISET)+BARHAW
         Y3(J)=Y2MAXG
         D3(J)=JD
         J=J+1
         X3(J)=DIST(ISET)-BARHAW
         Y3(J)=Y2MAXG
         D3(J)=JD
C
         JD=JD+1
         J=J+1
         X3(J)=DIST(ISET)-BARHAW
         Y3(J)=Y2MAXG
         D3(J)=JD
         J=J+1
         X3(J)=DIST(ISET)-BARHAW
         Y3(J)=Y2MING
         D3(J)=JD
C
 2400 CONTINUE
      N3=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BLO2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,ISUBRO,BARHEF,BARWEF
 9012 FORMAT('ICASPL,ISUBRO,BARHEF,BARWEF = ',A4,2X,A4,2X,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NDIST,N2,N3,IERROR
 9013 FORMAT('N,NDIST,N2,N3,IERROR = ',4I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)XWIDT2,XWIDTH,BARHAW
 9015 FORMAT('XWIDT2,XWIDTH,BARHAW = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
C
      DO9021I=1,N2
      WRITE(ICOUT,9022)I,Y2(I),X2(I),TAG2(I)
 9022 FORMAT('I,Y2(I),X2(I),TAG2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
C
      WRITE(ICOUT,9031)Y2RANG,Y2GAP
 9031 FORMAT('Y2RANG,Y2GAP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)Y2MIN,Y2MAX,Y2MING,Y2MAXG
 9032 FORMAT('Y2MIN,Y2MAX,Y2MING,Y2MAXG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N3
      WRITE(ICOUT,9036)I,Y3(I),X3(I),D3(I)
 9036 FORMAT('I,Y3(I),X3(I),D3(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBLO3(Y,X,TAG,N,ICASPL,DIST,NDIST,
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST.
     1MAXNXT,
     1ISEED,
     1Y2,X2,TAG2,N2,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--IF NO STATISTIC IS CALLED FOR,
C              CARRY OVER THE RAW DATA INTO Y2,X2,TAG2,N2.
C              IF A STATISTIC IS CALLED FOR,
C              COMPUTE THE STATISTICS AND COPY IT INTO Y2,X2,TAG2,N2.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 NATIONAL INSTITUTE OF STANDARDS & TECHNOLOGY
C                 GAITHERSBURG, MARYLAND 20899
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     ORIGINAL VERSION--JUNE    1992.
C     UPDATED         --AUGUST  1993.  ADD SOME DECLARATIONS
C     UPDATED         --DECEMBER  1993. LINFIT ARGS + GARBAGE VECTORS
C     UPDATED         --DECEMBER  1993. LINFIT ARGS: PROTECT RESSD/DF
C     UPDATED         --FEBRUARY  1994. COMMENT OUT 2 VARIABLE STATS
C     UPDATED         --NOVEMBER  1994. ISUBN2 TO ISUBN3
C     UPDATED         --MARCH     1995. AAD AND MAD STATISTICS
C     UPDATED         --MAY       1995. ADDITIONAL EQUIVALENCE
C     UPDATED         --NOVEMBER  1998. AAD PERCENTILE
C     UPDATED         --AUGUST    2002. CALL "CMPSTA" TO COMPUTE
C                                       STATISTICS
C     UPDATED         --APRIL     2003. SUPPORT FOR SN AND QN REQUIRES
C                                       ADDITIONAL SCRATCH ARRAYS
C                                       FOR CMPSTA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN3
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IWRITE
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION TAG(*)
C
      DIMENSION DIST(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION TAG2(*)
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
      DIMENSION TAG9(MAXOBV)
      DIMENSION DTAG9(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMPZ(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZI.INC'
C
      DIMENSION XTEMP1(MAXOBV)
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
C
      EQUIVALENCE (GARBAG(IGARB5),XTEMP1(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP2(1))
      EQUIVALENCE (GARBAG(IGARB7),TAG9(1))
      EQUIVALENCE (GARBAG(IGARB8),DTAG9(1))
      EQUIVALENCE (GARBAG(IGARB9),TEMP(1))
      EQUIVALENCE (GARBAG(IGAR10),XTEMP3(1))
      EQUIVALENCE (G2RBAG(IGAR11),TEMPZ(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
      INCLUDE 'DPCOST.INC'
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='DPBL'
      ISUBN3='O3  '
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BLO3')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPBLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ISUBRO
   53 FORMAT('ICASPL,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)N
   54 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),X(I),TAG(I)
   56 FORMAT('I, Y(I), X(I),TAG(I) = ',I8,3F15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,61)NDIST
   61 FORMAT('NDIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO62I=1,NDIST
      WRITE(ICOUT,63)I,DIST(I)
   63 FORMAT('I, DIST(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  LOOP THROUGH EACH DISTINCT HOR. AXIS VALUE. **
C               **  FOR A GIVEN HORIZONTAL AXIS VALUE--         **
C               **     COPY OVER THE RAW DATA, OR               **
C               **     COMPUTE THE STATISTIC                    **
C               **************************************************
C
      ISTEPN='24'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN3)
C
      IWRITE='OFF'
      N2=0
      DO1100ISET=1,NDIST
         NTAG9=0
         DO1200I=1,N
            IF(X(I).EQ.DIST(ISET))THEN
               NTAG9=NTAG9+1
               TAG9(NTAG9)=TAG(I)
            ENDIF
 1200    CONTINUE
         CALL DISTIN(TAG9,NTAG9,'OFF ',DTAG9,NDTAG9,IBUGG3,IERROR)
         CALL SORT(DTAG9,NDTAG9,DTAG9)
         DO1300K=1,NDTAG9
            NS2=0
            DO1400I=1,N
               IF(X(I).EQ.DIST(ISET).AND.TAG(I).EQ.DTAG9(K))THEN
                  NS2=NS2+1
                  TEMP(NS2)=Y(I)
               ENDIF
 1400       CONTINUE
C
      IF(ICASPL.EQ.'RAW ')THEN
        RIGHT=TEMP(1)
      ELSE
        CALL CMPSTA(
     1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1RIGHT,
     1ISUBRO,IBUGG3,IERROR)
      ENDIF
C
79000 CONTINUE
      N2=N2+1
      Y2(N2)=RIGHT
      X2(N2)=DIST(ISET)
      TAG2(N2)=DTAG9(K)
C
 1300    CONTINUE
 1100 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'BLO3')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBLO3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,ISUBRO
 9012 FORMAT('ICASPL,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NDIST,N2,IERROR
 9013 FORMAT('N,NDIST,N2,IERROR = ',3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NTAG9,NDTAG9,NS2
 9014 FORMAT('NTAG9,NDTAG9,NS2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
C
      DO9021I=1,N2
      WRITE(ICOUT,9022)I,Y2(I),X2(I),TAG2(I)
 9022 FORMAT('I,Y2(I),X2(I),TAG2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBLPA(IHARG,IHARG2,NUMARG,
     1IPSTBP,IFOUND,IERROR)
C
C     PURPOSE--TURN ON/OFF THE (INITIAL) BLANK PAGE SWITCH
C              FOR POSTSCRIPT.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IHARG2 (A CHARACTER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IPSTBP (A CHARACTER VECTOR
C                              WHICH CONTAINS THE
C                              POSTSCRIPT BLANK PAGE SWITCH (ON/OFF)
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--92/6
C     ORIGINAL VERSION--MAY       1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IPSTBP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
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)THEN
         IPSTBP='ON'
      ELSE
         IF(IHARG(NUMARG).EQ.'ON')IPSTBP='ON'
         IF(IHARG(NUMARG).EQ.'OFF')IPSTBP='OFF'
         IF(IHARG(NUMARG).EQ.'AUTO')IPSTBP='ON'
         IF(IHARG(NUMARG).EQ.'DEFA')IPSTBP='OFF'
      ENDIF
C
      IFOUND='YES'
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1181)
 1181    FORMAT('THE POSTSCRIPT (INITIAL) BLANK PAGE SWITCH')
      CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1182)IPSTBP
 1182    FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPBOB(NPTS,NLAB,
     1AMEAN,ASD,AMNX,AMXX,SW,
     1ASM,ASB,AKU,AKUK1,AKUK2,
     1DLOWBO,DHIGBO,STXMU,ST2SB,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT BOUNDS ON BIAS (BOB) APPROACH TO
C              CONSENSUS MEANS.  BASED ON MACRO PROVIDED BY
C              STEFAN LEIGH.
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL ASM
      REAL AMNX
      REAL AMXX
      REAL ASB
      REAL AKU
      REAL AKUK1
      REAL AKUK2
      REAL SW
      REAL AMEAN(*)
      REAL ASD(*)
C
C----------------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPVR'
      ISUBN2='ML  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'BOB')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPBOB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB,SW,STXMU,ST2SB
   52   FORMAT('NPTS,NLAB,SW,STXMU,ST2SB = ',2I8,3G15.7)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NLAB
          WRITE(ICOUT,56)I,AMEAN(I)
   56     FORMAT('I,AMEAN(I) = ',2I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      CALL MEAN(AMEAN,NLAB,IWRITE,ASM,IBUGA3,IERROR)
      DSB=DBLE(AMXX - AMNX)/DSQRT(12.0D0)
      DKU=2.0D0*DSQRT((SW**2) + (DSB**2))
      ASB=REAL(DSB)
      AKU=REAL(DKU)
      AKUK2=AKU
      AKUK1=AKU/2.0
      DLOWBO=DBLE(ASM - AKU)
      DHIGBO=DBLE(ASM + AKU)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5127   FORMAT('      </TD>')
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5128   FORMAT('   </TR>')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('         &nbsp;')
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         <b>4. Method: BOB (Bound On Bias):</b>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)ASM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
 5172   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Within Lab Uncertainty:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SW
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Between Lab Uncertainty:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)ASB
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Uncertainty (<i>k</i> = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AKU/2.0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)
 5179   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)AKU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lower 95% (k = 2) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWBO)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Upper 95% (k=2) Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGBO)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Note: BOB Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '5 or Fewer Labs')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
C
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 4. Method: BOB ',
     1         '(Bound on Bias):} & ',2X,A1,A1)
 8012   FORMAT(5X,'Estimate of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)ASM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8016   FORMAT(5X,'Within Lab Uncertainty: & ',
     1         F15.7,2X,A1,A1)
 8017   FORMAT(5X,'Between Lab Uncertainty: & ',
     1         F15.7,2X,A1,A1)
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8016)SW,IBASLC,IBASLC
        CALL DPWRST('XXX','RIT')
        WRITE(ICOUT,8017)ASB,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)AKU/2.0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)AKU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8026   FORMAT(5X,'Lower 95',A1,'% (k = 2) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% (k = 2) Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: BOB Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      5 or Fewer Labs & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8026)IBASLC,REAL(DLOWBO),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,REAL(DHIGBO),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 4. Method: BOB (Bound on Bias)'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=33
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=30
        IVALUE(1)='   Estimate of Consensus Mean:'
        AVALUE(2)=ASM
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=26
        IVALUE(1)='   Within Lab Uncertainty:'
        AVALUE(2)=SW
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=27
        IVALUE(1)='   Between Lab Uncertainty:'
        AVALUE(2)=ASB
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=AKU/2.0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=AKU
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DLOWBO)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DHIGBO)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: BOB Best Usage:'
        NCHAR(1)=24
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         5 or Fewer Labs:'
        NCHAR(1)=25
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('4.  Method: BOB (Bound on Bias)')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)ASM
 4002   FORMAT('    Estimate of Consensus Mean:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4006)SW
 4006   FORMAT('    Within Lab Uncertainty:                 ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4007)ASB
 4007   FORMAT('    Between Lab Uncertainty:                ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4012)AKU/2.0
 4012   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)AKU
 4013   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWBO)
 4022   FORMAT('    Lower 95% (k = 2) Confidence Limit:     ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGBO)
 4023   FORMAT('    Upper 95% (k = 2) Confidence Limit:     ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: BOB Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          5 or Fewer Labs')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'BOB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPBOB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ASM,ASB,AKU
 9014   FORMAT('ASM,ASB,AKU = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWBO,DHIGBO
 9015   FORMAT('DLOWBO,DHIGBO = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPBOCC(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXBOX,PBOXXC,PBOXYC,NUMBOX,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 PAIRS OF (X,Y) COORDINATES
C              FOR A BOX.
C              THE FIRST PAIR WILL BE FOR THE LOWER LEFT CORNER
C              OF THE BOX;
C              THE SECOND PAIR WILL BE FOR THE UPPER RIGHT CORNER
C              OF THE BOX.
C              THE (X1,Y1), (X2,Y2) COORDINATES WILL BE PLACED IN THE
C              FIRST AND SECOND ELEMENTS (RESPECTIVELY) OF
C              THE 2 BOXAYS PBOXXC(.,.) AND PBOXYC(.,.)
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXBOX
C     OUTPUT ARGUMENTS--PBOXXC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE ONE CORNER OF BOX I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE OPPOSITE CORNER OF BOX I;
C                     --PBOXYC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE ONE CORNER OF BOX I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE OPPOSITE CORNER OF BOX I;
C                     --NUMBOX = THE NUMBER OF BOXES DEFINED SO FAR
C                              (ACTUALLY, THE HIGHEST REFERENCED BOX SO FAR)
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--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --OCTOBER   1992. FIX BUG (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
C
      DIMENSION PBOXXC(100,2)
      DIMENSION PBOXYC(100,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
      ISUBN1='DPBO'
      ISUBN2='CC  '
C
      IFOUND='NO'
      IERROR='NO'
C
      HOLD1=0.0
      HOLD2=0.0
      HOLD3=0.0
      HOLD4=0.0
C
      IF(NUMARG.EQ.0)GOTO9000
CCCCC OCTOBER 1992.  DISTINGUISH: BOX 1 COORDINATES FROM
CCCCC BOX CORNER COORDINATES CASE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CORN'.AND.IHARG(2).EQ.'COOR')
     1GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(1).NE.'CORN'.AND.IHARG(2).EQ.'COOR')THEN
        ILASTC=2
        GOTO1140
      ENDIF
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')GOTO1110
      ILASTC=3
C  END CHANGE
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'COOR')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1120
      IF(IHARG(3).EQ.'OFF')GOTO1120
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.6)GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPBOCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE BOX ... CORNER COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE CORNER COORDINATES ARE SPECIFIED ',
     1'BY 4 NUMBERS, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      BOX 3 CORNER COORDINATES 30 50 40 60')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1120 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      NUMBOX=0
      GOTO1130
C
 1125 CONTINUE
      DO1126J=3,6
      IF(IARGT(J).EQ.'NUMB')GOTO1127
      GOTO1128
 1127 CONTINUE
      IF(J.EQ.3)HOLD1=ARG(J)
      IF(J.EQ.4)HOLD2=ARG(J)
      IF(J.EQ.5)HOLD3=ARG(J)
      IF(J.EQ.6)HOLD4=ARG(J)
      GOTO1126
 1128 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.3)HOLD1=VALUE(ILOC)
      IF(J.EQ.4)HOLD2=VALUE(ILOC)
      IF(J.EQ.5)HOLD3=VALUE(ILOC)
      IF(J.EQ.6)HOLD4=VALUE(ILOC)
 1126 CONTINUE
      NUMBOX=MAXBOX
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      PBOXXC(I,1)=HOLD1
      PBOXYC(I,1)=HOLD2
      PBOXXC(I,2)=HOLD3
      PBOXYC(I,2)=HOLD4
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)
 1136 FORMAT('ALL BOX CORNER COORDINATES HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PBOXXC(I,1),PBOXYC(I,1)
 1137 FORMAT('    (X,Y) FOR LOWER LEFT  CORNER OF BOX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PBOXXC(I,2),PBOXYC(I,2)
 1138 FORMAT('    (X,Y) FOR LOWER RIGHT CORNER OF BOX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
CCCCC OCTOBER 1992.  FOLLOWING SECTION MODIFIED TO HANDLE
CCCCC BOX <ID> COOR CASE.
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... CORNER COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 CORNER COORDINATES 30 50 40 60')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... CORNER COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
CCCCC IF(NUMARG.LE.3)GOTO1170
      IF(NUMARG.LE.ILASTC)GOTO1170
CCCCC IF(IHARG(4).EQ.'ON')GOTO1170
CCCCC IF(IHARG(4).EQ.'OFF')GOTO1170
CCCCC IF(IHARG(4).EQ.'AUTO')GOTO1170
CCCCC IF(IHARG(4).EQ.'DEFA')GOTO1170
      IFRSTC=ILASTC+1
      IF(IHARG(IFRSTC).EQ.'ON')GOTO1170
      IF(IHARG(IFRSTC).EQ.'OFF')GOTO1170
      IF(IHARG(IFRSTC).EQ.'AUTO')GOTO1170
      IF(IHARG(IFRSTC).EQ.'DEFA')GOTO1170
CCCCC IF(NUMARG.GE.7)GOTO1175
      IF(NUMARG.GE.IFRSTC+3)GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1170 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      IF(I.EQ.NUMBOX)NUMBOX=I-1
      GOTO1180
C
 1175 CONTINUE
CCCCC DO1176J=4,7
      DO1176J=IFRSTC,IFRSTC+3
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.4)HOLD1=ARG(J)
      IF(J.EQ.5)HOLD2=ARG(J)
      IF(J.EQ.6)HOLD3=ARG(J)
      IF(J.EQ.7)HOLD4=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.4)HOLD1=VALUE(ILOC)
      IF(J.EQ.5)HOLD2=VALUE(ILOC)
      IF(J.EQ.6)HOLD3=VALUE(ILOC)
      IF(J.EQ.7)HOLD4=VALUE(ILOC)
 1176 CONTINUE
      IF(I.GT.NUMBOX)NUMBOX=I
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PBOXXC(I,1)=HOLD1
      PBOXYC(I,1)=HOLD2
      PBOXXC(I,2)=HOLD3
      PBOXYC(I,2)=HOLD4
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I
 1186 FORMAT('THE CORNER COORDINATES FOR BOX ',I8,
     1' HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PBOXXC(I,1),PBOXYC(I,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PBOXXC(I,2),PBOXYC(I,2)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBOCC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBOCL(IHARG,IARGT,IARG,NUMARG,IDEFXC,
     1MAXBOX,IBOFCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR A BOX.
C              THE COLOR FOR A BOX IS THE COLOR
C              THAT WILL APPEAR ON THE BORDER OF THE BOX.
C              THE COLOR FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IBOFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFXC
C                     --MAXBOX
C     OUTPUT ARGUMENTS--IBOFCO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              COLOR FOR BOX I.
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--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --AUGUST    1992.  FEEDBACK MESSAGES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFXC
      CHARACTER*4 IBOFCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IBOFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFXC
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      IBOFCO(I)=IHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IBOFCO(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1136 FORMAT('ALL BOX COLORS HAVE JUST BEEN SET TO ',
 1136 FORMAT('ALL BOX BORDER COLORS HAVE JUST BEEN SET TO ',
     1A4)
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 COLOR GREEN')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFXC
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOFCO(I)=IHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IBOFCO(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1186 FORMAT('THE COLOR FOR BOX ',I8,
 1186 FORMAT('THE BORDER COLOR FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOFC(IHARG,IARGT,IARG,NUMARG,IDEFXC,
     1MAXBOX,IBOFCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE FILL PATTERN IN A BOX
C              I.E., THE COLOR
C              THAT WILL APPEAR IN THE INSIDE REGION OF THE BOX.
C              THE COLOR FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IBOFCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFXC
C                     --MAXBOX
C     OUTPUT ARGUMENTS--IBOFCO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              COLOR FOR BOX I.
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     ORIGINAL VERSION--AUGUST    1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFXC
      CHARACTER*4 IBOFCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IBOFCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'COLO')
     1GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'COLO')
     1GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1120
      IF(IHARG(3).EQ.'OFF')GOTO1120
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFXC
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(3)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      IBOFCO(I)=IHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IBOFCO(I)
 1136 FORMAT('ALL BOX FILL COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOFC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... FILL COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 FILL COLOR GREEN')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOFC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... FILL COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1170
      IF(IHARG(4).EQ.'OFF')GOTO1170
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFXC
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOFCO(I)=IHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IBOFCO(I)
 1186 FORMAT('THE FILL COLOR FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOFI(IBUGA2,IBUGA3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1ISEED,IBOOSS,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE BOOTSTRAP BASED MULTI-LINEAR FIT.
C              BOOTSTRAP ESTIMATES FOR A0, A1, ETC. WILL BE
C              WRITTEN TO FILE DPST1F.DAT.
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--2002/6
C     ORIGINAL VERSION--JULY     2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IBUGAZ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IOP
      CHARACTER*4 ICASFI
      CHARACTER*4 ICASJB
      CHARACTER*4 ICASEQ
      CHARACTER*4 IKEY
CCCCC CHARACTER*4 IHWUSE
CCCCC CHARACTER*4 MESSAG
      CHARACTER*4 IHRESP(MAXCMF)
      CHARACTER*4 IHRES2(MAXCMF)
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IPARN
CCCCC CHARACTER*4 IPARN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INTEGER ILOCRV(MAXCMF)
      INTEGER ICOLRV(MAXCMF)
CCCCC DIMENSION IPARN(100)
CCCCC DIMENSION IPARN2(100)
C
      DIMENSION PARAM(100)
      DIMENSION T(101)
      DIMENSION S(102)
      DIMENSION PARAM2(100)
      DIMENSION T2(101)
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZI.INC'
C
      DIMENSION W(MAXOBV)
      DIMENSION VSDPRD(MAXOBV)
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION RES3(MAXOBV)
      DIMENSION RES4(MAXOBV)
      DIMENSION ITEMP1(MAXOBV)
C
      DIMENSION XMAT(MAXOBV,MAXCMF)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
C
      EQUIVALENCE (W(1),X3D(1))
      EQUIVALENCE (PRED2(1),X(1))
      EQUIVALENCE (RES2(1),D(1))
      EQUIVALENCE (DFILL(1),VSDPRD(1))
      EQUIVALENCE (G2RBAG(IGAR11),XMAT(1,1))
      EQUIVALENCE (GARBAG(IGARB1),PARAM(1))
      EQUIVALENCE (GARBAG(IGARB1+200),T(1))
      EQUIVALENCE (GARBAG(IGARB1+400),S(1))
      EQUIVALENCE (GARBAG(IGARB1+600),PARAM2(1))
      EQUIVALENCE (GARBAG(IGARB1+800),T2(1))
      EQUIVALENCE (GARBAG(IGARB2),TEMP1(1))
      EQUIVALENCE (GARBAG(IGARB3),TEMP2(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP3(1))
      EQUIVALENCE (GARBAG(IGARB5),RES3(1))
      EQUIVALENCE (GARBAG(IGARB6),RES4(1))
      EQUIVALENCE (GARBAG(IGARB7),TEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPBO'
      ISUBN2='FI  '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=MAXCMF
      MINV2=2
      MINN2=2
      NQ=1
C
      NUMPV=(-999)
      IP=(-999)
      IV=(-999)
C
      IWIDMO=(-999)
C
      NUMIND=(-999)
C
C               ************************************
C               **  TREAT THE BOOTSTRAP FIT CASE  **
C               ************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BOFI')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3
   53 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGCO,IBUGEV,IBUGQ
   54 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMNAM
   56 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMNAM
      WRITE(ICOUT,58)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
   58 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
   90 CONTINUE
C
C     ***************************
C     **  STEP 1--             **
C     **  EXTRACT THE COMMAND  **
C     ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASJB='BOOT'
      IF(ICOM.EQ.'BOOT'.AND.IHARG(1).EQ.'FIT  ')THEN
        ICASJB='BOOT'
        GOTO111
      ENDIF
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASFI='MLIN'
C
C     *******************************************************
C     **  STEP 2--                                         **
C     **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C     *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=0
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C     ******************************************************
C     **  STEP 3--                                        **
C     **  FOR THE CASES WHEN HAVE FIT Y = SOME EXPRESSION **
C     **  DETERMINE IF WE HAVE A VALID FUNCTIONAL         **
C     **  EXPRESSION--IN PARTICULAR, CHECK THAT THE NUMBER**
C     **  OF ARGUMENTS IS AT LEAST 1, AND ALSO CHECK      **
C     **  THAT THERE IS EXACTLY 1 EQUAL SIGN AND THAT     **
C     **  THIS EQUAL SIGN OCCURS AS THE SECOND ARGUMENT.  **
C     ******************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.MINV2)THEN
        WRITE(ICOUT,2001)
 2001   FORMAT('***** ERROR IN DPBOFI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2002)
 2002   FORMAT('      NUMBER OF ARGUMENTS DETECTED IN BOOTSTRAP FIT ',
     1         'COMMAND < 2.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2003)NUMARG
 2003   FORMAT('      NEED DEPENDENT VARIABLE AND AT LEAST 3 ',
     1         'INDEPENDENT VARIABLES.  NUMARG = ',I3)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2008)(IANS(J),J=1,MIN(100,IWIDTH))
 2008     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      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.'    ')GOTO2110
 2100 CONTINUE
      ILOCQ=NUMARG+1
      GOTO2120
 2110 CONTINUE
      ILOCQ=J1
      GOTO2120
 2120 CONTINUE
C
      NQ=ILOCQ-1
C
      IF(NQ.GT.MAXV2+1)THEN
        WRITE(ICOUT,2145)MAXV2+1
 2145   FORMAT('**** ERROR FROM BOOTSTRAP FIT: MAXIMIUM NUMBER OF ',
     1         'VARIABLES,',I5,', EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     ****************************************************
C     **  STEP 4--                                      **
C     **  FOR ALL VARIATIONS OF THE COMMAND,            **
C     **  THE WORD AFTER  FIT  SHOULD BE THE RESPONSE   **
C     **  VARIABLE (= THE DEPENDENT VARIABLE).          **
C     **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE   **
C     **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN  **
C     **  FACT, A VARIABLE (AS OPPOSED TO A PARAMETER). **
C     **  NOTE: FOR IMPLICIT MODEL, NO RESPONSE         **
C     **        VARIABLE.                               **
C     ****************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2310J=1,NQ
        ILOCF1=J
        IF(J.EQ.1)THEN
          IHLEFT=IHARG(ILOCF1)
          IHLEF2=IHARG2(ILOCF1)
        ENDIF
        IHRESP(J)=IHARG(ILOCF1)
        IHRES2(J)=IHARG2(ILOCF1)
C
        DO2350I=1,NUMNAM
          I2=I
          IF(IHRESP(J).EQ.IHNAME(I2).AND.IHRES2(J).EQ.IHNAM2(I2).AND.
     1       IUSE(I2).EQ.'V')GOTO2379
 2350   CONTINUE
        WRITE(ICOUT,2361)
 2361   FORMAT('***** ERROR IN DPBOFI (BOOTSTRAP FIT)--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2362)
 2362   FORMAT('      THE NAME AFTER  THE WORD BOOTSTRAP FIT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2363)
 2363   FORMAT('      (WHICH SHOULD BE THE DEPENDENT VARIABLE)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2364)
 2364   FORMAT('      EITHER DOES NOT EXIST OR IS A PARAMETER ',
     1         '(AS OPPOSED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2366)
 2366   FORMAT('      TO A VARIABLE) IN THE CURRENT LIST OF')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2367)
 2367   FORMAT('      AVAILABLE VARIABLE AND PARAMETER NAMES.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2369)IHRESP(J),IHRES2(J)
 2369   FORMAT('      NAME AFTER THE WORD BOOTSTRAP FIT = ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
 2378     FORMAT('      COMMAND LINE--',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
C
 2379   CONTINUE
        IF(J.EQ.1)THEN
          ILOCV=I2
          ICOLL=IVALUE(ILOCV)
          NLEFT=IN(ILOCV)
        ELSE
          ILOCRV(J)=I2
          ICOLRV(J)=IVALUE(ILOCRV(J))
          NTEMP=IN(ILOCRV(J))
          IF(NTEMP.NE.NLEFT)THEN
            WRITE(ICOUT,2381)
 2381       FORMAT('***** ERROR IN DPBOFI (BOOTSTRAP FIT)--ALL ',
     1             'INDEPENDENT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2383)
 2383       FORMAT('      VARIABLES MUST HAVE THE SAME NUMBER OF ',
     1             'OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2385)IHRESP(J),IHRES2(J),NTEMP
 2385       FORMAT('      INDEPENDENT VARIABLE ',A4,A4,' HAS ',I8,
     1             'OBSERVATIONS.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,2387)NLEFT
 2387       FORMAT('      NUMBER OF OBSEVATIONS EXPECTED: ',I8)
            CALL DPWRST('XXX','BUG ')
            IF(IWIDTH.GE.1)THEN
              WRITE(ICOUT,2378)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
              CALL DPWRST('XXX','BUG ')
            ENDIF
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 2310 CONTINUE
C
 2390 CONTINUE
C
C     ****************************************************
C     **  STEP 5--                                      **
C     **  FOR ALL VARIATIONS OF THE COMMAND, CHECK THAT **
C     **  THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C     **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER AND  **
C     **  LESS THAN MAXOB2.                             **
C     ****************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NJUNK=MAX(MINN2,NQ-1)
      IF(NLEFT.GE.MINN2.AND.NLEFT.LE.MAXOBV)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPBOFI (BOOTSTRAP FIT)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS (FOR WHICH A ',
     1'(IN VARIABLE ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      BOOTSTRAP FIT ANALYSIS WAS TO HAVE BEEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      PERFORMED MUST BE AT LEAST ',I8,' AND NO MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      THAN ',I8,';  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)NLEFT
  317 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,319)(IANS(I),I=1,MIN(100,IWIDTH))
  319   FORMAT(100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               ************************************************
C               **  STEP 5.1--                                **
C               **  CHECK TO SEE IF HAVE A WEIGHTS VARIABLE.  **
C               **  IF DO HAVE, CHECK TO SEE IF A VARIABLE    **
C               **  (AS OPPOSED TO A PARAMETER).              **
C               ************************************************
C
      ISTEPN='5.1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PBOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCW=-99
      ICOLW=-99
      NWEIGH=-99
      IF(IWEIGH.EQ.'OFF')GOTO2490
      DO2450I=1,NUMNAM
      I2=I
      IF(IWEIG1.EQ.IHNAME(I2).AND.IWEIG2.EQ.IHNAM2(I2).AND.
     1IUSE(I2).EQ.'V')GOTO2479
 2450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2461)
 2461 FORMAT('***** ERROR IN DPBOFI--THE WEIGHTS VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2463)
 2463 FORMAT('      (AS SPECIFIED VIA THE WEIGHTS COMMAND) EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2465)
 2465 FORMAT('      DOES NOT EXIST OR IS A PARAMETER (AS OPPOSED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2466)
 2466 FORMAT('      TO A VARIABLE) IN THE CURRENT LIST OF AVAILABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2468)
 2468 FORMAT('      VARIABLE AND PARAMETER NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2469)IWEIG1,IWEIG2
 2469 FORMAT('      NAME OF SPECIFIED WEIGHTS VARIABLE = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,2478)(IANS(J),J=1,IWIDTH)
 2478   FORMAT('      COMMAND LINE--',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
 2479 CONTINUE
      ILOCW=I2
      ICOLW=IVALUE(ILOCW)
      NWEIGH=IN(ILOCW)
 2490 CONTINUE
C
      IF(NTEMP.NE.NLEFT)THEN
        WRITE(ICOUT,2581)
 2581   FORMAT('***** ERROR IN DPBOFI (BOOTSTRAP FIT)--THE WEIGHT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2583)
 2583   FORMAT('      VARIABLE MUST HAVE THE SAME NUMBER OF ',
     1         'OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2585)IWEIGH,IWEIG2,NWEIGH
 2585   FORMAT('  WEIGHT VARIABLE ',A4,A4,' HAS ',I8,'OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2587)NLEFT
 2587   FORMAT('      NUMBER OF OBSEVATIONS EXPECTED: ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2478)(IANS(JJ),JJ=1,MIN(100,IWIDTH))
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C     **********************************************
C     **  STEP 6.3--                              **
C     **  FOR ALL VARIATIONS OF THE FIT COMMAND,  **
C     **  CHECK TO SEE THE TYPE CASE--            **
C     **    1) UNQUALIFIED (THAT IS, FULL);       **
C     **    2) SUBSET/EXCEPT; OR                  **
C     **    3) FOR.                               **
C     **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL 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'
      IKEY='SUBS'
      IF(IHARG(J1).EQ.'EXCE')IKEY='EXCE'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BOFI')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C     *****************************************************
C     **  STEP 12--                                      **
C     **  BRANCH TO THE APPROPRIATE SUBCASE; THEN        **
C     **  COPY OVER THE DEPENDENT VARIABLE AND THE       **
C     **  THE INDPENENDENT VARIABLES INTO THE MATRIX     **
C     **  XMAT.  ALSO, CREATE A COLUMN OF "1"'s IN THE  **
C     **  MODEL INCLUDES AN ADDITIVE CONSTANT.           **
C     *****************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,601)N,ILOCQ-1
  601   FORMAT('N,ILOCQ-1 = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      NTEMP=NLEFT
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NTEMP
      ISUB(I)=1
  615 CONTINUE
      NQZ=NTEMP
      GOTO650
C
  620 CONTINUE
      NIOLD=NTEMP
      CALL DPSUB2(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NTEMP
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQZ=NFOR
      GOTO650
C
  650 CONTINUE
      IFACT=1
      IF(IFITAC.EQ.'OFF')IFACT=0
C
      J=0
      DO4450I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4450
        J=J+1
 4450 CONTINUE
      NS=J
C
      J=0
      DO4500I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4500
        K=ICOLL
        J=J+1
        IJ=MAXN*(K-1)+I
        IF(K.LE.MAXCOL)Y(J)=V(IJ)
        IF(K.EQ.MAXCP1)Y(J)=PRED(I)
        IF(K.EQ.MAXCP2)Y(J)=RES(I)
        IF(K.EQ.MAXCP3)Y(J)=YPLOT(I)
        IF(K.EQ.MAXCP4)Y(J)=XPLOT(I)
        IF(K.EQ.MAXCP5)Y(J)=X2PLOT(I)
        IF(K.EQ.MAXCP6)Y(J)=TAGPLO(I)
 4500 CONTINUE
C
      N2=J
C
      IF(IFITAC.EQ.'ON')THEN
        DO4510I=1,NS
          XMAT(I,1)=1.0
 4510   CONTINUE
        NVARS=1
      ELSE
        NVARS=0
      ENDIF
C
      J=0
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4501)
 4501   FORMAT('***** FROM DPBOFI, FORMING XMAT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4503)NS,IFACT,NTEMP,NQ
 4503   FORMAT('NS,IFACT,NTEMP,NQ = ',4(I8,2X))
        CALL DPWRST('XXX','BUG ')
        DO4505I=1,ILOCQ
        WRITE(ICOUT,4507)I,ICOLRV(I),ILOCRV(I)
 4507   FORMAT('I,ICOLRV(I),ILOCRV(I) = ',3(I8,2X))
        CALL DPWRST('XXX','BUG ')
 4505   CONTINUE
      ENDIF
C
      J=0
      NFRST=2
      NLAST=NQ
      DO4520I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4520
        J=J+1
        DO4600L=NFRST,NLAST
          K=ICOLRV(L)
          IJ=MAXN*(K-1)+I
          ICOL=L-NFRST+1+NVARS
          IF(K.LE.MAXCOL)XMAT(J,ICOL)=V(IJ)
          IF(K.EQ.MAXCP1)XMAT(J,ICOL)=PRED(I)
          IF(K.EQ.MAXCP2)XMAT(J,ICOL)=RES(I)
          IF(K.EQ.MAXCP3)XMAT(J,ICOL)=YPLOT(I)
          IF(K.EQ.MAXCP4)XMAT(J,ICOL)=XPLOT(I)
          IF(K.EQ.MAXCP5)XMAT(J,ICOL)=X2PLOT(I)
          IF(K.EQ.MAXCP6)XMAT(J,ICOL)=TAGPLO(I)
 4600   CONTINUE
 4520 CONTINUE
      NVARS=NVARS+(NLAST-NFRST+1)
C
      J=0
      DO4720I=1,NTEMP
        IF(ISUB(I).EQ.0)GOTO4720
        IF(IWEIGH.EQ.'OFF')THEN
          J=J+1
          W(J)=1.0
        ELSE
          J=J+1
          K=ICOLW
          IJ=MAXN*(K-1)+I
          IF(K.LE.MAXCOL)W(J)=V(IJ)
          IF(K.EQ.MAXCP1)W(J)=PRED(I)
          IF(K.EQ.MAXCP2)W(J)=RES(I)
          IF(K.EQ.MAXCP3)W(J)=YPLOT(I)
          IF(K.EQ.MAXCP4)W(J)=XPLOT(I)
          IF(K.EQ.MAXCP5)W(J)=X2PLOT(I)
          IF(K.EQ.MAXCP6)W(J)=TAGPLO(I)
        ENDIF
 4700   CONTINUE
C
 4720 CONTINUE
      NVARS=NLAST-NFRST+2
C
C               ****************************************************************
C               **  STEP 11--
C               **  DUMP THE COMMON VECTOR V(.) OUT ONTO MASS STORAGE
C               **  SO AS TO PRESERVE THEIR CONTENTS FOR LATER USE
C               **  (AFTER DPFIT2).
C               **  THE ABOVE DUMP TO MASS STORAGE IS UNNECESSARY AND IS NOT DON
C               **  FOR THE SPECIAL CASE WHEN THE NUMBER OF PARAMETERS
C               **  IS 0 (A NO-FIT CASE WHEREBY WE ARE REALLY INTERESTED
C               **  IN GENERATING PREDICTED VALUES AND RESIDUALS
C               **  FOR A GIVEN FULLY-SPECIFIED MODEL).
C               ****************************************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOP='WRIT'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
C               *************************************************
C               **  STEP 14--                                  **
C               **  CARRY OUT THE ACTUAL FIT                   **
C               **  VIA CALLING                                **
C               **  DPBOF2 (FOR GENERAL MODELS), OR            **
C               *************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IBUGAZ=IBUGA3
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BOFI')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPBOFI, AS ABOUT TO CALL DPBOF2--')
      CALL DPWRST('XXX','BUG ')
      DO6083I=1,N
      WRITE(ICOUT,6084)I,(XMAT(I,J),J=1,5)
 6084 FORMAT('I,(XMAT(I,J),J=1,5) = ',I6,2X,5G15.7)
      CALL DPWRST('XXX','BUG ')
 6083 CONTINUE
      WRITE(ICOUT,6082)NLEFT,MAXN,NS,NVARS
 6082 FORMAT('NLEFT,MAXN,NS,NVARS = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6091)IBUGA3,IBUGCO,IBUGEV
 6091 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
 6520 CONTINUE
C
      CALL DPBOF2(Y,XMAT,N2,NVARS,MAXOBV,MAXCMF,
     1PARAM,T,S,W,VSDPRD,PRED2,RES2,V,
     1PARAM2,T2,RES3,RES4,
     1TEMP1,TEMP2,TEMP3,TEMP4,ITEMP1,
     1ICASFI,ICASJB,IBOOME,IBOOSS,ISEED,
     1IBUGA3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO6590
C
 6590 CONTINUE
C
      IOP='READ'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BOFI')GOTO8129
      WRITE(ICOUT,8121)
 8121 FORMAT('WE ARE IN DPBOFI AND HAVE JUST READ ',
     1'V(.) BACK IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8122)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1)
 8122 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS,V(1),PRED(1),RES(1) = ',
     15I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
 8129 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BOFI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'BOFI')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBOFI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3,NS
 9012 FORMAT('IBUGA2,IBUGA3,NS = ',A4,2X,A4,1X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMNAM
 9016 FORMAT('NUMNAM = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9017I=1,NUMNAM
      WRITE(ICOUT,9018)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I),
     1VALUE(I)
 9018 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),IVALUE(I)',
     1'VALUE(I) = ',I8,2X,A4,A4,2X,A4,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9017 CONTINUE
 9042 CONTINUE
 9049 CONTINUE
      WRITE(ICOUT,9051)NLEFT,NS,V(1),PRED(1),RES(1)
 9051 FORMAT('NLEFT,NS,V(1),PRED(1),RES(1) = ',2I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)ICASEQ
 9052 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9061)IWIDTH
 9061 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,9062)(IANS(I),I=1,MIN(100,IWIDTH))
 9062   FORMAT('(IANS(I),I=1,IWIDTH) = ',100A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,9069)IFOUND,IERROR
 9069 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBOF2(Y,XMAT,N,NVARS,MAXOBV,MAXCMF,
     1B,T,S,W,VSDPRD,PRED,RES,SCR,
     1BORG,TORG,RES1,RES2,
     1TEMP1,TEMP2,TEMP3,TEMP4,ITEMP1,
     1ICASFI,iCASJB,IBOOME,IBOOSS,ISEED,
     1IBUGA3,ISUBRO,IERROR)
C
C     BOOTSTRAP MULTILINEAR FIT.
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--2002/7
C     ORIGINAL VERSION--JULY      2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBOOME
      CHARACTER*4 ICASFI
      CHARACTER*4 ICASJB
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 IWRITE
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*3 IPARNM
C
C---------------------------------------------------------------------
C
      INTEGER N, NVARS
      INTEGER ITEMP1(*)
C
      REAL Y(MAXOBV)
      REAL XMAT(MAXOBV,MAXCMF)
      REAL B(*)
      REAL T(*)
      REAL S(*)
      REAL BORG(*)
      REAL TORG(*)
      REAL W(MAXOBV)
      REAL VSDPRD(MAXOBV)
      REAL PRED(MAXOBV)
      REAL RES(MAXOBV)
      REAL RES1(*)
      REAL RES2(*)
      REAL SCR(*)
      REAL TEMP1(MAXOBV)
      REAL TEMP2(MAXOBV)
      REAL TEMP3(MAXOBV)
      REAL TEMP4(MAXOBV)
C
      DOUBLE PRECISION DSUM1
C
      INCLUDE 'DPCOF2.INC'
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='DPBO'
      ISUBN2='F2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'BOF2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBOF2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NVARS
   52 FORMAT('N,NVARS= ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBOOSS,IBOOME
   54 FORMAT('IBOOSS, IBOOME = ',I8,A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
        WRITE(ICOUT,56)I,Y(I),W(I)
   56   FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
        CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      DO65I=1,N
        WRITE(ICOUT,66)I,(XMAT(I,J),J=1,MIN(5,NVARS))
   66   FORMAT('I,(XMAT(I,J),J=1,MIN(NVARS,5) = ',I8,5E15.7)
        CALL DPWRST('XXX','BUG ')
   65 CONTINUE
   90 CONTINUE
C
C               **************************************************
C               **  STEP 0.5--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='0.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'FIT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='BOF2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='BOF2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='BOF2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4='UNFORMATTED'
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='BOF2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************************************************
C               **  STEP 1--                                       **
C               **  PRINT SUMMARY INFORMATION.                     **
C               *****************************************************
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('BOOTSTRAP LINEAR/MULTILINEAR FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)N
  103 FORMAT('NUMBER OF OBSERVATIONS         = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)IBOOSS
  104 FORMAT('NUMBER OF BOOTSTRAP SAMPLES    = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IBOOME.EQ.'DATA')THEN
        WRITE(ICOUT,912)
  912   FORMAT('BOOTSTRAP METHOD               = DATA (WU METHOD)')
        CALL DPWRST('XXX','BUG ')
      ELSE
        WRITE(ICOUT,922)
  922   FORMAT('BOOTSTRAP METHOD               = RESIDUALS (EFRON ',
     1         ' METHOD)')
        CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,105)
  105 FORMAT('                              SUMMARY TABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,107)
  107 FORMAT(
     1'            ESTIMATES FROM                            ',
     1'                                ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,108)
  108 FORMAT(
     1'PARA-        ORIGINAL FIT            ESTIMATES FROM ',
     1'  BOOTSTRAP FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,109)
  109 FORMAT(
     1'METER     COEF        SD          MEAN         SD ',
     1'        2.5          97.5')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  BOOTSTRAP FIT BY "DATA" METHOD.                **
C               *****************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')
     1  CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NPAR=NVARS
      IT=2
      ICASJB='BOOT'
      NRESAM=IBOOSS
C
      IF(IBOOME.EQ.'DATA')THEN
C
C  GENERATE FIT FROM ORIGINAL DATA
C
        CALL LSQRTX(Y,W,N,XMAT,MAXOBV,NPAR,IT,
     1             B,RES,T,VSDPRD,S,RESSSQ,D,RESSD,NDF,SCR,ID,
     1             IBUGA3,ISUBRO,IERROR)
        DO210I=1,NPAR
          BORG(I)=B(I)
          TORG(I)=T(I)
  210   CONTINUE
C
C  SAVE ORIGINAL DATA TO UNFORMATTED FILE FOR FAST ACCESS
C
        WRITE(IOUNI4)Y
        WRITE(IOUNI4)XMAT
        WRITE(IOUNI4)W
        IENDF4='OFF'
        IREWI4='ON'
        CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1              IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
        IF(IERRF4.EQ.'YES')GOTO9000
C
        DO110IRESAM=1,NRESAM
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')THEN
             WRITE(ICOUT,112)IRESAM
  112        FORMAT('FROM DPBOFI, IRESAM = ',I8)
             CALL DPWRST('XXX','BUG ')
          ENDIF
          IREWI4='ON'
          CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
          READ(IOUNI4)Y
          READ(IOUNI4)XMAT
          READ(IOUNI4)W
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')THEN
            DO155I=1,N
              WRITE(ICOUT,156)I,Y(I),W(I)
  156         FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
              CALL DPWRST('XXX','BUG ')
  155       CONTINUE
            DO165I=1,N
              WRITE(ICOUT,166)I,(XMAT(I,J),J=1,MIN(5,NVARS))
  166         FORMAT('I,(XMAT(I,J),J=1,MIN(NVARS,5) = ',I8,5E15.7)
              CALL DPWRST('XXX','BUG ')
  165       CONTINUE
          ENDIF
          IENDF4='OFF'
          IREWI4='ON'
          CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1                IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
          IF(IERRF4.EQ.'YES')GOTO9000
C
          CALL DPJBS3(Y,N,ICASJB,IRESAM,ISEED,TEMP1,N2,ITEMP1,
     1                TEMP4,IBUGA3,IERROR)
C
          DO120J=1,N
            Y(J)=TEMP1(J)
            TEMP2(J)=W(ITEMP1(J))
  120     CONTINUE
          DO125J=1,N
            W(J)=TEMP2(J)
  125     CONTINUE
C
          DO130L=1,NVARS
            DO135J=1,N
              TEMP3(J)=XMAT(ITEMP1(J),L)
  135       CONTINUE
            DO138J=1,N
              XMAT(J,L)=TEMP3(J)
  138       CONTINUE
  130     CONTINUE
C
          CALL LSQRTX(Y,W,N,XMAT,MAXOBV,NPAR,IT,
     1               B,RES,T,VSDPRD,S,RESSSQ,D,RESSD,NDF,SCR,ID,
     1               IBUGA3,ISUBRO,IERROR)
C
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')THEN
             WRITE(ICOUT,142)
  142        FORMAT('FROM DPBOFI, BEFORE WRITE TO FILES')
             CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(IOUNI1,'(35E15.7)')(B(LL),LL=1,NPAR)
          WRITE(IOUNI2,'(35E15.7)')(T(LL),LL=1,NPAR)
          WRITE(IOUNI3,'(E15.7)')RESSD
C
  110   CONTINUE
      ELSE
C
C               *****************************************************
C               **  STEP 3--                                       **
C               **  BOOTSTRAP FIT BY "RESIDUAL" METHOD             **
C               *****************************************************
C
C
C  GENERATE FIT FROM ORIGINAL DATA
C
        CALL LSQRTX(Y,W,N,XMAT,MAXOBV,NPAR,IT,
     1             B,RES,T,VSDPRD,S,RESSSQ,D,RESSD,NDF,SCR,ID,
     1             IBUGA3,ISUBRO,IERROR)
        DO710I=1,NPAR
          BORG(I)=B(I)
          TORG(I)=T(I)
  710   CONTINUE
C
C  COMPUTE AND STORE RESIDUALS FROM ORIGINAL FIT
C
        DO720I=1,N
          DSUM1=0.0
          DO725J=1,NPAR
            DSUM1 = DSUM1 + DBLE(BORG(J)*XMAT(I,J))
  725     CONTINUE
          RES1(I) = Y(I) - REAL(DSUM1)
  720   CONTINUE
C
C  RESAMPLE RESIDUALS, COMPUTE NEW Y (XMAT STAYS CONSTANT, SO
C  NO NEED TO SAVE/RELOAD ORIGINAL X MATRIX).
C
        DO610IRESAM=1,NRESAM
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')THEN
             WRITE(ICOUT,662)IRESAM
  662        FORMAT('FROM DPBOFI, IRESAM = ',I8)
             CALL DPWRST('XXX','BUG ')
          ENDIF
C
          CALL DPJBS3(RES1,N,ICASJB,IRESAM,ISEED,RES2,N2,ITEMP1,
     1                TEMP4,IBUGA3,IERROR)
C
          DO620I=1,N
            DSUM1=0.0
            DO625J=1,NPAR
              DSUM1 = DSUM1 + DBLE(BORG(J)*XMAT(I,J))
  625       CONTINUE
            TEMP3(I) = RES2(I) + REAL(DSUM1)
  620     CONTINUE
C
          CALL LSQRTX(TEMP3,W,N,XMAT,MAXOBV,NPAR,IT,
     1               B,RES,T,VSDPRD,S,RESSSQ,D,RESSD,NDF,SCR,ID,
     1               IBUGA3,ISUBRO,IERROR)
C
          IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')THEN
             WRITE(ICOUT,642)
  642        FORMAT('FROM DPBOF2, BEFORE WRITE TO FILES')
             CALL DPWRST('XXX','BUG ')
          ENDIF
          WRITE(IOUNI1,'(35E15.7)')(B(LL),LL=1,NPAR)
          WRITE(IOUNI2,'(35E15.7)')(T(LL),LL=1,NPAR)
          WRITE(IOUNI3,'(E15.7)')RESSD
C
  610   CONTINUE
      ENDIF
C
C               **************************************
C               **  STEP 4--                        **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8200 CONTINUE
C
      ISTEPN='82'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
C               *********************************************
C               **  STEP 5--                               **
C               **  COMPUTE AND PRINT SUMMARY INFORMATION. **
C               *********************************************
C
 8500 CONTINUE
C
      ISTEPN='85'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  REOPEN DPST1F.DAT, DPST2F.DAT TO RETRIEVE PARAMETER AND
C  PARAMETER SD ESTIMATES.
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='BOF2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='BOF2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IWRITE='OFF'
      DO8510J=1,NPAR
        DO8520I=1,NRESAM
          READ(IOUNI1,'(35E15.7)',END=8599,ERR=8599)(B(LL),LL=1,NPAR)
          READ(IOUNI2,'(35E15.7)',END=8599,ERR=8599)(T(LL),LL=1,NPAR)
          TEMP1(I)=B(J)
          TEMP2(I)=T(J)
 8520   CONTINUE
        CALL MEDIAN(TEMP1,NRESAM,IWRITE,TEMP3,MAXOBV,XMED,
     1              IBUGA3,IERROR)
        CALL MEAN(TEMP1,NRESAM,IWRITE,XMEAN,IBUGA3,IERROR)
        CALL MEAN(TEMP2,NRESAM,IWRITE,XSD,IBUGA3,IERROR)
        P100=2.5
        CALL PERCEN(P100,TEMP1,NRESAM,IWRITE,TEMP3,MAXOBV,
     1              X025,IBUGA3,IERROR)
        P100=97.5
        CALL PERCEN(P100,TEMP1,NRESAM,IWRITE,TEMP3,MAXOBV,
     1              X975,IBUGA3,IERROR)
        IPARNM(1:3)='A  '
        IF(J.LE.9)THEN
          WRITE(IPARNM(2:2),'(I1)')J-1
        ELSE
          WRITE(IPARNM(2:3),'(I2)')J-1
        ENDIF
        WRITE(ICOUT,8529)IPARNM,BORG(J),TORG(J),XMEAN,XSD,X025,X975
 8529   FORMAT(A3,3X,6(E12.5))
        CALL DPWRST('XXX','BUG ')
        REWIND(IOUNI1)
        REWIND(IOUNI2)
 8510 CONTINUE
 8599 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
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
C
C
C               ****************************************************
C               **  STEP 6--                                      **
C               **  WRITE INFO OUT TO FILES--                     **
C               **     1) DPST1F.DAT--XXXXX                       **
C               ****************************************************
C
 8100 CONTINUE
C
      ISTEPN='81'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BOF2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO8119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)
 8112 FORMAT('COEFFICIENT ESTIMATES WRITTEN  TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)
 8114 FORMAT('COEFFICIENT STANDARD DEVIATIONS WRITTEN TO FILE ',
     1       'DPST2F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8116)
 8116 FORMAT('RESIDUAL STANDARD DEVIATIONS WRITTEN TO FILE ',
     1       'DPST3F.DAT')
      CALL DPWRST('XXX','BUG ')
 8119 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO8129
 8129 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
C
CCCCC BE SURE TO RESET DPST4F.DAT TO FORMATTED.
C
      IFORM4='FORMATTED'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'BOF2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBOF2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBOFP(IHARG,IARGT,IARG,NUMARG,IDEFPA,
     1MAXBOX,IBOFPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE FILL PATTERN FOR A BOX.
C              THE FILL PATTERN FOR A BOX IS THE PATTERN
C              THAT WILL APPEAR IN THE INSIDE REGION OF THE BOX.
C              THE PATTERN FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IBOFPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C                     --MAXBOX
C     OUTPUT ARGUMENTS--IBOFPA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              PATTERN FOR BOX I.
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--92/8
C     ORIGINAL VERSION--AUGUST    1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFPA
      CHARACTER*4 IBOFPA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IBOFPA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'PATT')
     1GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'PATT')
     1GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1123
      IF(IHARG(3).EQ.'SOLI')GOTO1123
      IF(IHARG(3).EQ.'EMPT')GOTO1124
      IF(IHARG(3).EQ.'OFF')GOTO1124
      IF(IHARG(3).EQ.'BLAN')GOTO1124
      IF(IHARG(3).EQ.'NONE')GOTO1124
      IF(IHARG(3).EQ.'HOLL')GOTO1124
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFPA
      GOTO1130
C
 1123 CONTINUE
      IHOLD='ON'
      GOTO1130
C
 1124 CONTINUE
      IHOLD='OFF'
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(3)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      IBOFPA(I)=IHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IBOFPA(I)
 1136 FORMAT('ALL BOX FILL PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOFP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... FILL PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 FILL PATTERN ON')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOFP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... FILL PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1173
      IF(IHARG(4).EQ.'SOLI')GOTO1173
      IF(IHARG(4).EQ.'OFF')GOTO1174
      IF(IHARG(4).EQ.'EMPT')GOTO1174
      IF(IHARG(4).EQ.'BLAN')GOTO1174
      IF(IHARG(4).EQ.'NONE')GOTO1174
      IF(IHARG(4).EQ.'HOLL')GOTO1174
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1173 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1174 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOFPA(I)=IHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IBOFPA(I)
 1186 FORMAT('THE FILL PATTERN FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOFT(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXBOX,PBOFTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR A BOX.
C              THE THICKNESS FOR A BOX IS THE THICKNESS
C              THAT WILL APPEAR IN THE INSIDE REGION OF THE BOX.
C              THE THICKNESS FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PBOFTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C                     --MAXBOX
C     OUTPUT ARGUMENTS--PBOFTH (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              THICKNESS FOR BOX I.
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--92/8
C     ORIGINAL VERSION--AUGUST    1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFTH
      REAL        PBOFTH
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PBOFTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'THIC')
     1GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'THIC')
     1GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1120
      IF(IHARG(3).EQ.'OFF')GOTO1120
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFTH
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(3)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      PBOFTH(I)=PHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PBOFTH(I)
 1136 FORMAT('ALL BOX FILL THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOFT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... FILL THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 FILL THICKNESS 0.3')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOFT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... FILL THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1170
      IF(IHARG(4).EQ.'OFF')GOTO1170
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PBOFTH(I)=PHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PBOFTH(I)
 1186 FORMAT('THE FILL THICKNESS FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOFG(IHARG,IARGT,IARG,ARG,NUMARG,PDEFGA,
     1MAXBOX,PBOPGA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE GAP FOR A BOX.
C              THE GAP FOR A BOX IS THE GAP
C              BETWEEN THE LINES OF A REGION FILL PATTERN.
C              THE GAP FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PBOPGA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFGA
C                     --MAXBOX
C     OUTPUT ARGUMENTS--PBOPGA (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              GAP FOR BOX I.
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--92/8
C     ORIGINAL VERSION--AUGUST    1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFGA
      REAL        PBOPGA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PBOPGA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'GAP')
     1GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'GAP')
     1GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1120
      IF(IHARG(3).EQ.'OFF')GOTO1120
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFGA
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(3)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      PBOPGA(I)=PHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PBOPGA(I)
 1136 FORMAT('ALL BOX FILL GAPS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOFG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... FILL GAP COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 FILL GAP 1.0')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOFG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... FILL GAP COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1170
      IF(IHARG(4).EQ.'OFF')GOTO1170
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFGA
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(4)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PBOPGA(I)=PHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PBOPGA(I)
 1186 FORMAT('THE FILL GAP FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOFL(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPBOFL(IHARG,IARGT,IARG,NUMARG,IDEFPA,
     1MAXBOX,IBOPPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LINE PATTERN FOR THE FILL OF
C              A BOX.  THIS ONLY APPLIES FOR NON-SOLID FILL
C              PATTERNS (E.G., HORI, VERT, ETC.)
C              THE PATTERN FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IBOPPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C                     --MAXBOX
C     OUTPUT ARGUMENTS--IBOPPA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              PATTERN FOR BOX I.
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--92/8
C     ORIGINAL VERSION--AUGUST    1992.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFPA
      CHARACTER*4 IBOPPA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IBOPPA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'LINE')
     1GOTO1110
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'LINE')
     1GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.2)GOTO1120
      IF(IHARG(3).EQ.'ON')GOTO1123
      IF(IHARG(3).EQ.'SOLI')GOTO1123
      IF(IHARG(3).EQ.'EMPT')GOTO1124
      IF(IHARG(3).EQ.'OFF')GOTO1124
      IF(IHARG(3).EQ.'BLAN')GOTO1124
      IF(IHARG(3).EQ.'NONE')GOTO1124
      IF(IHARG(3).EQ.'HOLL')GOTO1124
      IF(IHARG(3).EQ.'AUTO')GOTO1120
      IF(IHARG(3).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFPA
      GOTO1130
C
 1123 CONTINUE
      IHOLD='SOLI'
      GOTO1130
C
 1124 CONTINUE
      IHOLD='BLAN'
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'5')IHOLD='DA5'
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      IBOPPA(I)=IHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IBOPPA(I)
 1136 FORMAT('ALL BOX FILL LINES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... FILL LINE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 FILL LINE ON')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... FILL LINE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.3)GOTO1170
      IF(IHARG(4).EQ.'ON')GOTO1173
      IF(IHARG(4).EQ.'SOLI')GOTO1173
      IF(IHARG(4).EQ.'OFF')GOTO1174
      IF(IHARG(4).EQ.'EMPT')GOTO1174
      IF(IHARG(4).EQ.'BLAN')GOTO1174
      IF(IHARG(4).EQ.'NONE')GOTO1174
      IF(IHARG(4).EQ.'HOLL')GOTO1174
      IF(IHARG(4).EQ.'AUTO')GOTO1170
      IF(IHARG(4).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1173 CONTINUE
      IHOLD='SOLI'
      GOTO1180
C
 1174 CONTINUE
      IHOLD='BLAN'
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(4)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(4).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(4).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(4).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(4).EQ.'5')IHOLD='DA5'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOPPA(I)=IHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IBOPPA(I)
 1186 FORMAT('THE FILL LINE FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPBOPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
     1MAXBOX,IBOFPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE LINE TYPE FOR THE BORDER BOX.
C              THE PATTERN FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IBOFPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C                     --MAXBOX
C     OUTPUT ARGUMENTS--IBOFPA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              PATTERN FOR BOX I.
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--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --AUGUST    1992.  FORMAT STATEMENTS
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFPA
      CHARACTER*4 IBOFPA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IBOFPA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PATT')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFPA
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'5')IHOLD='DA5'
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      IBOFPA(I)=IHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IBOFPA(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1136 FORMAT('ALL BOX PATTERNS HAVE JUST BEEN SET TO ',
 1136 FORMAT('ALL BOX BORDER PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 PATTERN SOLID')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'5')IHOLD='DA5'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOFPA(I)=IHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IBOFPA(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1186 FORMAT('THE PATTERN FOR BOX ',I8,
 1186 FORMAT('THE BORDER PATTERN FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOSS(IHARG,IARGT,IARG,NUMARG,
     1IBOOSS,IDEBOO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BOOTSTRAP SAMPLE SIZE
C              THE SPECIFIED BOOTSTRAP SAMPLE SIZE WILL BE PLACED
C              IN THE INTEGER VARIABLE    IBOOSS
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG    (AN INTEGER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IBOOSS (AN INTEGER 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
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 IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'=')GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAMP')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'SAMP')GOTO1150
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPBOSS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR BOOTSTRAP SAMPLE SIZE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      EXAMPLES OF ALLOWABLE FORMS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('          BOOTSTRAP SAMPLE SIZE 200')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('          BOOTSTRAP SIZE 50')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)IDEBOO
 1133 FORMAT('      THE DEFAULT BOOTSTRAP SAMPLE SIZE ',
     1'IS ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEBOO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IBOOSS=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBOOSS
 1181 FORMAT('THE BOOTSTRAP SAMPLE SIZE HAS JUST BEEN SET TO ',
     1I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOTH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXBOX,PBOFTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR A BOX.
C              THE THICKNESS FOR A BOX IS THE THICKNESS
C              OF THE BORDER REGION OF THE BOX.
C              THE THICKNESS FOR BOX I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PBOFTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C                     --MAXBOX
C     OUTPUT ARGUMENTS--PBOFTH (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              THICKNESS FOR BOX I.
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--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --AUGUST    1992.  FORMAT STATEMENTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFTH
      REAL        PBOFTH
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PBOFTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'THIC')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFTH
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXBOX
      PBOFTH(I)=PHOLD
 1135 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PBOFTH(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1136 FORMAT('ALL BOX THICKNESSS HAVE JUST BEEN SET TO ',
 1136 FORMAT('ALL BOX BORDER THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPBOTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE BOX ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE BOX IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      BOX 3 THICKNESS 0.3')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXBOX)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPBOTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE BOX ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXBOX
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PBOFTH(I)=PHOLD
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PBOFTH(I)
      CALL DPWRST('XXX','BUG ')
CCCCC AUGUST 1992.
C1186 FORMAT('THE THICKNESS FOR BOX ',I8,
 1186 FORMAT('THE BORDER THICKNESS FOR BOX ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBOX(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IFENCE,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 2 BOX PLOTS--
C              1) MEDIAN;
C              2) MEAN;
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   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     2002. SUPPORT FOR FIXED WIDTH BOX PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IFENCE
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      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='DPBO'
      ISUBN2='X   '
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
      ICOLH=0
C
C               *******************************
C               **  TREAT THE BOX PLOT CASE  **
C               *******************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBOX--')
      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)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IFENCE
   54 FORMAT('IFENCE = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               **********************************
C               **  STEP 1.1--                  **
C               **  SEARCH FOR MEDIAN BOX PLOT  **
C               **********************************
C
      ICASPL='MDBP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEDI'.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BOX'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
C               ********************************
C               **  STEP 1.2--                **
C               **  SEARCH FOR MEAN BOX PLOT  **
C               ********************************
C
      ICASPL='MEBP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'XBAR'.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'BOX'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='    '
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL 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 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.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(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 3--                                                 **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.                **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.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 DPBOX--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDBP')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A (MEDIAN) BOX PLOT ')
      IF(ICASPL.EQ.'MDBP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEBP')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A MEAN BOX PLOT ')
      IF(ICASPL.EQ.'MEBP')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
  390 CONTINUE
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(IBUGG2.EQ.'ON')CALL 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 DPBOX')
      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')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 5--                                              **
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 BOX 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='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)GOTO530
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPBOX--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDBP')WRITE(ICOUT,512)
  512 FORMAT('      FOR A (MEDIAN) BOX PLOT, ')
      IF(ICASPL.EQ.'MDBP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEBP')WRITE(ICOUT,513)
  513 FORMAT('      FOR A MEAN BOX PLOT, ')
      IF(ICASPL.EQ.'MEBP')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)NUMV2
  522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,524)(IANS(I),I=1,IWIDTH)
  524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      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')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO590
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPBOX--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MDBP')WRITE(ICOUT,572)
  572 FORMAT('      FOR A (MEDIAN) BOX PLOT CHART, ')
      IF(ICASPL.EQ.'MDBP')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MEBP')WRITE(ICOUT,573)
  573 FORMAT('      FOR A MEAN BOX PLOT,')
      IF(ICASPL.EQ.'MEBP')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARAIBLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,NLEFT
  584 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHHOR,NHOR
  586 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
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(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO660
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
  660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 7--                                                  **
C               **  FOR THE 1-VARIABLE CASE ONLY,                             *
C               **  DETERMINE IF THE ANALYST                                  **
C               **  HAS SPECIFIED    THE GROUP SIZE,                          **
C               **  FOR THE BOX PLOT      ANALYSIS.                           **
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING THE        **
C               **  INTERNAL TABLE FOR THE PARAMETER NAME      NI   ;         **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                        **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.                  **
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(NUMV2.GE.2)GOTO790
C
CCCCC IH='NI  '
CCCCC IH2='    '
CCCCC IHWUSE='P'
CCCCC MESSAG='YES'
CCCCC CALL CHECKN(IH,IH2,IHWUSE,
CCCCC1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
CCCCC1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
CCCCC IERROR=IERRO2
CCCCC IF(IERRO2.EQ.'YES')GOTO9000
CCCCC ISIZE=VALUE(ILOCP)+0.5
CC790 CONTINUE
C
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  COMPUTE THE APPROPRIATE BOX PLOT      STATISTIC--      **
C               **  (MEDIAN OR MEDAN ).                                    **
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='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPBOX2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,IFENCE,IBXPWI,
     1XIDTEM,TEMP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
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 DPBOX--')
      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)IFENCE,ISIZE
 9014 FORMAT('IFENCE,ISIZE = ',A4,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 DPBOX2(Y,X,N,NUMV2,ICASPL,ISIZE,ICONT,IFENCE,IBXPWI,
     1XIDTEM,TEMP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A BOX PLOT
C              OF THE FOLLOWING TYPES--
C                 1) (MEDIAN) BOX PLOT;
C                 2) MEAN BOX 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--JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  BUG--MULTI-BOX PLOTS W/FENCES (ALAN)
C     UPDATED         --MARCH     2002.  SUPPORT FIXED WIDTH BOX PLOTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IFENCE
      CHARACTER*4 IBXPWI
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
      INCLUDE 'DPCOPA.INC'
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='DPBO'
      ISUBN2='X2  '
C
      I2=0
      ISIZE2=0
C
      AN=0.0
      SIZE=0.0
      SIZE2=0.0
      XWIDTH=0.0
      XWIDT2=0.0
      YBARI=0.0
      SDI=0.0
      YMED=0.0
C
      H=0.0
      STEP=0.0
      AINNFU=0.0
      AOUTFU=0.0
      IREV=0
      AINNFL=0.0
      AOUTFL=0.0
C  BUG FIX: AUGUST, 1987
C           IF FENCES ON AND MORE THAN ONE SET OF BOX PLOTS DONE,
C           CAN GET GARBAGE.  NEED TO INITIALIZE X2, Y2, D2
      DO 10 I=1,MAXOBV
      X2(I)=0.0
      Y2(I)=0.0
      D2(I)=0.0
 10   CONTINUE
C  END FIX
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 DPBOX2--')
      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 DPBOX2--')
      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=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 DPBOX2--')
      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(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPBOX2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMV2,ISIZE,ICONT
   71 FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT = ',I8,2X,A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IFENCE
   72 FORMAT('IFENCE = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,N
      WRITE(ICOUT,76)I,Y(I),X(I)
   76 FORMAT('I, Y(I), X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR VARIABLE 2 (THE GROUP VARIABLE).              **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR A BOX PLOT.       **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO110
      IF(NUMV2.EQ.2)GOTO150
C
  110 CONTINUE
CCCCC NUMSET=0
CCCCC DO120I=ISIZE,N,ISIZE
CCCCC I2=I
CCCCC NUMSET=NUMSET+1
CCCCC XIDTEM(NUMSET)=NUMSET
CC120 CONTINUE
CCCCC IF(I2.LT.N)GOTO130
CCCCC GOTO140
CC130 CONTINUE
CCCCC NUMSET=NUMSET+1
CCCCC XIDTEM(NUMSET)=NUMSET
CC140 CONTINUE
CCCCC DO145I=1,N
CCCCC IGROUP=1+((I-1)/ISIZE)
CCCCC IMID=(IGROUP-1)*ISIZE+(ISIZE/2)
CCCCC X(I)=IMID
CC145 CONTINUE
CCCCC GOTO190
      DO120I=1,N
      X(I)=1.0
  120 CONTINUE
      NUMSET=1
      XIDTEM(1)=X(1)
      GOTO190
C
  150 CONTINUE
      NUMSET=0
      DO160I=1,N
      IF(NUMSET.EQ.0)GOTO165
      DO170J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO160
  170 CONTINUE
  165 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  160 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      XID1=XIDTEM(1)
      XID2=XIDTEM(NUMSET)
C
  190 CONTINUE
C
      IF(NUMSET.EQ.0)WRITE(ICOUT,191)
  191 FORMAT('ERROR IN DPBOX2   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.0)IERROR='YES'
C
      IF(NUMSET.EQ.N)WRITE(ICOUT,192)
  192 FORMAT('ERROR IN DPBOX2   SUBROUTINE--NUMSET = N')
      IF(NUMSET.EQ.N)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.N)IERROR='YES'
      IF(NUMSET.EQ.N)GOTO9000
C
C               **********************************
C               **  STEP 2--                    **
C               **  IF NECESSARY,               **
C               **  COMPUTE AVERAGE CLASS SIZE  **
C               **********************************
C
      ISTEPN='2'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AN=N
      ANUMSE=NUMSET
C
      SIZE=ISIZE
      SIZE2=SIZE
CCCCC IF(NUMV2.NE.1)SIZE2=AN/ANUMSE
      SIZE2=AN/ANUMSE
      ISIZE2=SIZE2+0.5
C
C               ***********************************
C               **  STEP 3--                     **
C               **  COMPUTE MINIMUM CLASS WIDTH  **
C               ***********************************
C
      ISTEPN='3'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMSET.EQ.1)XWIDTH=0.10*XIDTEM(1)
      IF(NUMSET.EQ.1)GOTO390
      XWIDTH=CPUMAX
      IMAX=NUMSET-1
      DO300I=1,IMAX
      IP1=I+1
      XWIDT2=XIDTEM(IP1)-XIDTEM(I)
      IF(XWIDT2.LT.XWIDTH)XWIDTH=XWIDT2
  300 CONTINUE
  390 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  COMPUTE MAXIMUM SUBSAMPLE SIZE  **
C               **************************************
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NIMAX=0
      DO400ISET=1,NUMSET
C
      K=0
      DO420I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
  420 CONTINUE
      NI=K
      IF(NI.GT.NIMAX)NIMAX=NI
C
  400 CONTINUE
      ANIMAX=NIMAX
C
C               **************************************************************
C               **  STEP 5--                                                **
C               **  IN ORDER TO DETERMINE THE PROPER PLOT COOORDINATES      **
C               **  FOR THE DESIRED PLOT,                                   **
C               **  FIRST BRANCH TO THE PROPER SUBCASE--                    **
C               **         1) (MEDIAN) BOX PLOT;                            **
C               **         2) MEAN BOX PLOT;                                **
C               **************************************************************
C
      ISTEPN='5'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'MDBP')GOTO1100
      IF(ICASPL.EQ.'MEBP')GOTO1100
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPBOX2')
      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('      MDBP    OR    MEBP,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ***************************************************
C               **  STEP 5A--                                    **
C               **  DETERMINE PLOT COORDINATES FOR 2 SUBCASES--  **
C               **      1) (MEDIAN) BOX PLOT;                    **
C               **      2) MEAN BOX PLOT;                        **
C               ***************************************************
C
 1100 CONTINUE
C
      ISTEPN='4A'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMCPL=11
      J=0
      JD=0
      DO1110ISET=1,NUMSET
C
      K=0
      DO1120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1120 CONTINUE
      NI=K
      ANI=NI
C
      IF(NI.LE.0)GOTO1140
      CALL SORT(TEMP,NI,TEMP)
C
      XMID=XIDTEM(ISET)
C
CCCCC MARCH 2002: SUPPORT EITHER FIXED OR VARIABLE WIDTH
CCCCC BOX PLOTS.
      IF(IBXPWI.EQ.'FIXE')THEN
        FACTOR=1.0
      ELSE
        FACTOR=SQRT(ANI/ANIMAX)
      ENDIF
      XLEFT=XMID-(XWIDTH/4.0)*FACTOR
      XRIGHT=XMID+(XWIDTH/4.0)*FACTOR
C
C               ***************************
C               **  STEP 5.1--           **
C               **  COMPUTE THE MAXIMUM  **
C               ***************************
C
      YMAX=TEMP(NI)
C
C               ***********************************************
C               **  STEP 5.2--                               **
C               **  COMPUTE THE POINT AT THE TOP OF THE BOX  **
C               **  (THE UPPER HINGE FOR A MEDIAN BOX PLOT)  **
C               **  (XBAR + 2 STANDARD DEVIATIONS            **
C               **  FOR A MEAN BOX PLOT)                     **
C               ***********************************************
C
      IF(ICASPL.EQ.'MDBP')GOTO1121
      IF(ICASPL.EQ.'MEBP')GOTO1122
C
 1121 CONTINUE
      NI2=(NI+1)/2
      IARG1=(NI2+1)/2
      IARG2=(NI2+1)-IARG1
      IARG1R=NI-IARG1+1
      IARG2R=NI-IARG2+1
      Y75=(TEMP(IARG1R)+TEMP(IARG2R))/2.0
      GOTO1129
C
 1122 CONTINUE
      SUM=0.0
      DO1124I=1,NI
      SUM=SUM+TEMP(I)
 1124 CONTINUE
      YBARI=SUM/ANI
C
      SUM=0.0
      DO1126I=1,NI
      SUM=SUM+(TEMP(I)-YBARI)**2
 1126 CONTINUE
      DENOM=ANI-1.0
      VARI=0.0
      IF(NI.GE.2)VARI=SUM/DENOM
      SDI=0.0
      IF(VARI.GT.0.0)SDI=SQRT(VARI)
      Y75=YBARI+2.0*SDI
 1129 CONTINUE
C
C               ***************************************
C               **  STEP 5.3--                       **
C               **  COMPUTE UPPER CONFIDENCE LIMITS  **
C               **  FOR THE MEAN                     **
C               ***************************************
C
      IF(ICASPL.EQ.'MDBP')YUCL=Y75
      IF(ICASPL.EQ.'MEBP')YUCL=YBARI+2.0*SDI/SQRT(ANI)
C
C               *********************************
C               **  STEP 5.4--                 **
C               **  COMPUTE THE TYPICAL VALUE  **
C               **  (MEDIAN OR MEAN)           **
C               *********************************
C
      IF(ICASPL.EQ.'MDBP')GOTO1131
      IF(ICASPL.EQ.'MEBP')GOTO1132
C
 1131 CONTINUE
      N50=NI/2
      N50P1=N50+1
      IEVODD=NI-2*(NI/2)
      IF(IEVODD.EQ.0)YMED=(TEMP(N50)+TEMP(N50P1))/2.0
      IF(IEVODD.EQ.1)YMED=TEMP(N50P1)
      Y50=YMED
      GOTO1133
C
 1132 CONTINUE
      Y50=YBARI
      GOTO1133
C
 1133 CONTINUE
C
C               ****************************************************
C               **  STEP 5.5--                                    **
C               **  COMPUTE LOWER CONFIDENCE LIMITS FOR THE MEAN  **
C               ****************************************************
C
      IF(ICASPL.EQ.'MDBP')YLCL=Y50
      IF(ICASPL.EQ.'MEBP')YLCL=YBARI-2.0*SDI/SQRT(ANI)
C
C               ****************************************************
C               **  STEP 5.6--                                    **
C               **  COMPUTE THE POINT AT THE BOTTOM OF THE BOX    **
C               **  (THE LOWER HINGE FOR A MEDIAN BOX PLOT)       **
C               **  (XBAR - 2 STANDARD DEVIATIONS                 **
C               **  FOR A MEAN BOX PLOT)                          **
C               ****************************************************
C
      IF(ICASPL.EQ.'MDBP')GOTO1135
      IF(ICASPL.EQ.'MEBP')GOTO1136
C
 1135 CONTINUE
      NI2=(NI+1)/2
      IARG1=(NI2+1)/2
      IARG2=(NI2+1)-IARG1
      Y25=(TEMP(IARG1)+TEMP(IARG2))/2.0
      GOTO1137
C
 1136 CONTINUE
      Y25=YBARI-2.0*SDI
      GOTO1137
C
 1137 CONTINUE
C
C               ***************************
C               **  STEP 5.7--           **
C               **  COMPUTE THE MINIMUM  **
C               ***************************
C
      YMIN=TEMP(1)
C
      GOTO1149
C
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** INTERNAL ERROR IN DPBOX2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)ISET,XIDTEM(ISET),NI
 1143 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C               *********************************************************
C               **  STEP 5.7A--                                        **
C               **  FOR THE UPPER HALF OF THE DATA--                   **
C               **  COMPUTE THE OUTER FENCE, THE INNER FENCE, AND THE  **
C               **  ADJACENT VALUE                                     **
C               *********************************************************
C
      H=Y75-Y25
      STEP=1.5*H
C
      AINNFU=Y75+STEP
      AOUTFU=Y75+2.0*STEP
      YADJU=Y75
      DO1155I=1,NI
      IREV=NI-I+1
      IF(TEMP(IREV).LE.AINNFU)GOTO1156
 1155 CONTINUE
      GOTO1159
 1156 CONTINUE
      YADJU=TEMP(IREV)
 1159 CONTINUE
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1157)Y75,YADJU,TEMP(IREV),IREV
 1157 FORMAT('Y75,YADJU,TEMP(IREV),IREV = ',3E15.7,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *********************************************************
C               **  STEP 5.7B--                                        **
C               **  FOR THE LOWER HALF OF THE DATA--                   **
C               **  COMPUTE THE OUTER FENCE, THE INNER FENCE, AND THE  **
C               **  ADJACENT VALUE                                     **
C               *********************************************************
C
      AINNFL=Y25-STEP
      AOUTFL=Y25-2.0*STEP
      YADJL=Y25
      DO1165I=1,NI
      I2=I
      IF(TEMP(I2).GE.AINNFL)GOTO1166
 1165 CONTINUE
      GOTO1169
 1166 CONTINUE
      YADJL=TEMP(I2)
 1169 CONTINUE
C
 1170 CONTINUE
C
C               ********************************************
C               **  STEP 6.1--                           **
C               **  IF IFENCE IS OFF, THEN               **
C               **  DEFINE THE CHARACTER AT THE MAXIMUM.  **
C               **  IF IFENCE IS ON, THEN                **
C               **  DEFINE THE CHARACTER AT THE UPPER ADJACENT VALUE;  **
C               ********************************************
C
      IF(IFENCE.EQ.'OFF')
     1CALL DPCHLI(ICONT,NUMCPL,YMAX,YMAX,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      IF(IFENCE.EQ.'ON')
     1CALL DPCHLI(ICONT,NUMCPL,YADJU,YADJU,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ****************************************
C               **  STEP 6.2--                       **
C               **  DEFINE THE CHARACTER AT THE TOP   **
C               **  OF THE BOX                        **
C               **  (UPPER HINGE CHARACTER, IF ANY).  **
C               ****************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y75,Y75,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ****************************************************************
C               **  STEP 6.3--                                               **
C               **  DEFINE THE CHARACTER IN THE BOX                           **
C               **  BUT TOWARDS THE TOP OF THE BOX                            **
C               **  (SUCH AS AN UPPER CONFIDENCE LIMIT FOR THE MEAN, IF ANY)  **
C               ****************************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YUCL,YUCL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ***************************************
C               **  STEP 6.4--                      **
C               **  DEFINE THE CHARACTER IN THE BOX  **
C               **  NEAR THE MIDDLE                  **
C               **  (SUCH AS THE MEDIAN OR MEAN)     **
C               ***************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y50,Y50,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ***************************************************************
C               **  STEP 6.5--                                              **
C               **  DEFINE THE CHARACTER IN THE BOX                          **
C               **  BUT TOWARDS THE BOX OF THE BOX                           **
C               **  (SUCH AS A LOWER CONFIDENCE LIMIT FOR THE MEAN, IF ANY)  **
C               ***************************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YLCL,YLCL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ******************************************
C               **  STEP 6.6--                         **
C               **  DEFINE THE CHARACTER AT THE BOTTOM  **
C               **  OF THE BOX                          **
C               **  (LOWER HINGE CHARACTER, IF ANY).    **
C               ******************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y25,Y25,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ********************************************
C               **  STEP 6.7--                           **
C               **  IF IFENCE IS OFF, THEN               **
C               **  DEFINE THE CHARACTER AT THE MINIMUM.  **
C               **  IF IFENCE IS ON, THEN                **
C               **  DEFINE THE CHARACTER AT THE LOWER ADJACENT VALUE;  **
C               ********************************************
C
      IF(IFENCE.EQ.'OFF')
     1CALL DPCHLI(ICONT,NUMCPL,YMIN,YMIN,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      IF(IFENCE.EQ.'ON')
     1CALL DPCHLI(ICONT,NUMCPL,YADJL,YADJL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               *************************************
C               **  STEP 6.8--                    **
C               **  IF IFENCE IS OFF, THEN            ZZ
C               **  DEFINE THE VERTICAL LINE FROM  **
C               **  THE MAXIMUM VALUE TO THE TOP OF THE BOX  **
C               **  IF IFENCE IS ON, THEN            ZZ
C               **  DEFINE THE VERTICAL LINE FROM  **
C               **  THE UPPER ADJACENT VALUE TO THE TOP OF THE BOX  **
C               *************************************
C
      IF(IFENCE.EQ.'OFF')
     1CALL DPCHLI(ICONT,NUMCPL,YMAX,Y75,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      IF(IFENCE.EQ.'ON')
     1CALL DPCHLI(ICONT,NUMCPL,YADJU,Y75,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               *******************************************************
C               **  STEP 6.9--                                      **
C               **  DEFINE THE VERTICAL LINE                         **
C               **  FROM THE TOP OF THE BOX (THE UPPER HINGE POINT)  **
C               **  TO THE POINT IN THE BOX TOWARD THE TOP           **
C               **  (SUCH AS THE UPPER CONFIDENCE LIMIT POINT)       **
C               *******************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y75,YUCL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               **************************************************
C               **  STEP 6.10--                                 **
C               **  DEFINE THE VERTICAL LINE                    **
C               **  FROM THE POINT IN THE BOX TOWARD THE TOP    **
C               **  (SUCH AS THE UPPER CONFIDENCE LIMIT POINT)  **
C               **  TO THE POINT IN THE BOX                     **
C               **  IN THE MIDDLE                               **
C               **  (SUCH AS THE MEDIAN OR MEAN)                **
C               **************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YUCL,Y50,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               **************************************************
C               **  STEP 6.11--                                 **
C               **  DEFINE THE VERTICAL LINE                    **
C               **  FROM THE POINT IN THE BOX                   **
C               **  IN THE MIDDLE                               **
C               **  (SUCH AS THE MEDIAN OR MEAN)                **
C               **  TO THE POINT IN THE BOX TOWARD THE BOTTOM   **
C               **  (SUCH AS THE LOWER CONFIDENCE LIMIT POINT)  **
C               **************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y50,YLCL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ********************************************************
C               **  STEP 6.12--                                       **
C               **  DEFINE THE VERTICAL LINE                          **
C               **  FROM THE POINT IN THE BOX TOWARD THE BOTTOM       **
C               **  (SUCH AS THE LOWER CONFIDENCE LIMIT POINT)        **
C               **  TO THE BOTTOM OF THE BOX (THE LOWER HINGE POINT)  **
C               ********************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YLCL,Y25,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               **********************************
C               **  STEP 6.13--                 **
C               **  IF IFENCE IS OFF, THEN      **
C               **  DEFINE THE VERTICAL LINE    **
C               **  FROM THE BOTTOM OF THE BOX  **
C               **  TO THE MINIMUM VALUE                  **
C               **  IF IFENCE IS ON, THEN      **
C               **  DEFINE THE VERTICAL LINE    **
C               **  FROM THE BOTTOM OF THE BOX  **
C               **  TO THE LOWER ADJACENT VALUE                  **
C               **********************************
C
      IF(IFENCE.EQ.'OFF')
     1CALL DPCHLI(ICONT,NUMCPL,Y25,YMIN,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      IF(IFENCE.EQ.'ON')
     1CALL DPCHLI(ICONT,NUMCPL,Y25,YADJL,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
C
C               *********************************************
C               **  STEP 6.14--                            **
C               **  DEFINE THE VERTICAL LINE               **
C               **  CONSTITUTING THE LEFT SIDE OF THE BOX  **
C               **  WHICH GOES FROM THE TOP OF THE BOX     **
C               **  TO THE BOTTOM OF THE BOX               **
C               *********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y75,Y25,XLEFT,XLEFT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               **********************************************
C               **  STEP 6.15--                             **
C               **  DEFINE THE VERTICAL LINE                **
C               **  CONSTITUTING THE RIGHT SIDE OF THE BOX  **
C               **  WHICH GOES FROM THE TOP OF THE BOX      **
C               **  TO THE BOTTOM OF THE BOX                **
C               **********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y75,Y25,XRIGHT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ***********************************************
C               **  STEP 6.16--                              **
C               **  DEFINE THE HORIZONTAL LINE               **
C               **  AT THE TOP OF THE BOX                    **
C               **  (RUNNING THROUGH THE UPPER HINGE POINT)  **
C               ***********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y75,Y75,XLEFT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ****************************************************
C               **  STEP 6.17--                                   **
C               **  DEFINE THE HORIZONTAL LINE                    **
C               **  IN THE BOX                                    **
C               **  (RUNNING THROUGH THE UPPER CONFIDENCE LIMIT)  **
C               ****************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YUCL,YUCL,XLEFT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               *********************************************
C               **  STEP 6.18--                            **
C               **  DEFINE THE HORIZONTAL LINE             **
C               **  IN THE BOX                             **
C               **  (RUNNING THROUGHT THE MEDIAN OR MEAN)  **
C               *********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y50,Y50,XLEFT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ****************************************************
C               **  STEP 6.19--                                   **
C               **  DEFINE THE HORIZONTAL LINE                    **
C               **  IN THE BOX                                    **
C               **  (RUNNING THROUGH THE LOWER CONFIDENCE LIMIT)  **
C               ****************************************************
C
      CALL DPCHLI(ICONT,NUMCPL,YLCL,YLCL,XLEFT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               ***********************************************
C               **  STEP 6.20--                              **
C               **  DEFINE THE HORIZONTAL LINE               **
C               **  AT THE BOTTOM OF THE BOX                 **
C               **  (RUNNING THROUGH THE LOWER HINGE POINT)  **
C               ***********************************************
C
      CALL DPCHLI(ICONT,NUMCPL,Y25,Y25,XLEFT,XRIGHT,J,JD,Y2,X2,D2,
     1IERROR)
C
C               *********************************************************
C               **  STEP 6.20B--                                       **
C               **  IF A BOX PLOT WITH NO FENCES HAS BEEN CALLED FOR,  **
C               **  THEN SKIP PAST THE FINAL 4 SPECIFICATIONS.         **
C               *********************************************************
C
      IF(IFENCE.EQ.'OFF')GOTO1110
C
C               *********************************************************
C               **  STEP 6.21--                                        **
C               **  DEFINE THE CHARACTER FOR THE UPPER FAR OUT VALUES  **
C               **  (BEYOND THE UPPER OUTER FENCE)                     **
C               *********************************************************
C
      YTEMP=Y25
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
C
      IPASS=0
      DO1215I=1,NI
      IREV=NI-I+1
      YTEMP=TEMP(IREV)
      IF(YTEMP.LE.AOUTFU)GOTO1219
      IPASS=IPASS+1
      IF(IPASS.EQ.1)J=J-1
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
 1215 CONTINUE
 1219 CONTINUE
      JD=JD+1
C
C               *********************************************************
C               **  STEP 6.22--                                        **
C               **  DEFINE THE CHARACTER FOR THE UPPER NEAR OUT VALUES  **
C               **  (BETWEEN THE UPPER INNER AND OUTER FENCES)
C               *********************************************************
C
      YTEMP=Y25
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
C
      IPASS=0
      DO1225I=1,NI
      IREV=NI-I+1
      YTEMP=TEMP(IREV)
      IF(YTEMP.GE.AOUTFU)GOTO1225
      IF(YTEMP.LE.AINNFU)GOTO1229
      IPASS=IPASS+1
      IF(IPASS.EQ.1)J=J-1
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
 1225 CONTINUE
 1229 CONTINUE
      JD=JD+1
C
C               *********************************************************
C               **  STEP 6.23--                                        **
C               **  DEFINE THE CHARACTER FOR THE LOWER NEAR OUT VALUES  **
C               **  (BETWEEN THE LOWER INNER AND OUTER FENCES)
C               *********************************************************
C
      YTEMP=Y25
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
C
      IPASS=0
      DO1235I=1,NI
      I2=I
      YTEMP=TEMP(I2)
      IF(YTEMP.LE.AOUTFL)GOTO1235
      IF(YTEMP.GE.AINNFL)GOTO1239
      IPASS=IPASS+1
      IF(IPASS.EQ.1)J=J-1
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
 1235 CONTINUE
 1239 CONTINUE
      JD=JD+1
C
C               *********************************************************
C               **  STEP 6.24--                                        **
C               **  DEFINE THE CHARACTER FOR THE LOWER FAR OUT VALUES  **
C               **  (BEYOND THE LOWER OUTER FENCE)
C               *********************************************************
C
      YTEMP=Y25
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
C
      IPASS=0
      DO1245I=1,NI
      I2=I
      YTEMP=TEMP(I2)
      IF(YTEMP.GE.AOUTFL)GOTO1249
      IPASS=IPASS+1
      IF(IPASS.EQ.1)J=J-1
      CALL DPCHLI(ICONT,NUMCPL,YTEMP,YTEMP,XMID,XMID,J,JD,Y2,X2,D2,
     1IERROR)
      JD=JD-1
 1245 CONTINUE
 1249 CONTINUE
      JD=JD+1
C
      IF(IBUGG3.EQ.'OFF')GOTO1259
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1251)
 1251 FORMAT('***** FROM THE MIDDLE OF DPBOX2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1252)ANI,J,JD,XMID
 1252 FORMAT('ANI,J,JD,XMID = ',E15.7,I8,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1253)YMAX,Y75,Y50,Y25,YMIN
 1253 FORMAT('YMAX,Y75,Y50,Y25,YMIN = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1254)H,STEP,Y75,YADJU,AINNFU,AOUTFU
 1254 FORMAT('H,STEP,Y75,YADJU,AINNFU,AOUTFU = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1255)H,STEP,Y25,YADJL,AINNFL,AOUTFL
 1255 FORMAT('H,STEP,Y25,YADJL,AINNFL,AOUTFL = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
 1259 CONTINUE
C
 1110 CONTINUE
C
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBOX2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFENCE
 9013 FORMAT('IFENCE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMV2,ISIZE,SIZE,SIZE2,ISIZE2
 9014 FORMAT('NUMV2,ISIZE,SIZE,SIZE2,ISIZE2 = ',2I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)AN,XWIDT2,XWIDTH
 9015 FORMAT('AN,XWIDT2,XWIDTH = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)YMAX,Y75,Y50,Y25,YMIN
 9021 FORMAT('YMAX,Y75,Y50,Y25,YMIN = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)H,STEP,Y75,YADJU,AINNFU,AOUTFU
 9022 FORMAT('H,STEP,Y75,YADJU,AINNFU,AOUTFU = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)H,STEP,Y25,YADJL,AINNFL,AOUTFL
 9023 FORMAT('H,STEP,Y25,YADJL,AINNFL,AOUTFL = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I)
 9036 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBPCO(IHARG,NUMARG,IDEBPC,MAXBAR,IBAPCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR PATTERN COLORS = THE COLORS
C              OF THE LINES MAKING UP A PATTERN WITHIN A BAR.
C              THESE ARE LOCATED IN THE VECTOR IBAPCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBPC
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBAPCO (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBPC
      CHARACTER*4 IBAPCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBAPCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBP'
      ISUBN2='CO  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBPC
   55 FORMAT('IDEBPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBAPCO(1)
   70 FORMAT('IBAPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBAPCO(I)
   76 FORMAT('I,IBAPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBAPCO(1)=IDEBPC
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPC
      IBAPCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBAPCO(I)
 1276 FORMAT('THE COLOR OF BAR PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPC
      DO1315I=1,NUMBAR
      IBAPCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBAPCO(I)
 1316 FORMAT('THE COLOR OF ALL BAR PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBPC
 9015 FORMAT('IDEBPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBAPCO(1)
 9030 FORMAT('IBAPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBAPCO(I)
 9036 FORMAT('I,IBAPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBPLI(IHARG,IHARG2,NUMARG,IDEBPL,MAXBAR,IBAPLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPBPLI(IHARG,NUMARG,IDEBPL,MAXBAR,IBAPLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN LINES = THE LINES TYPES
C              OF THE PATTERN WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBAPLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBPL
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBAPLI (A CHARACTER VECTOR)
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  1983.
C     UPDATED  VERSION--AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEBPL
      CHARACTER*4 IBAPLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IBAPLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBP'
      ISUBN2='LI  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBPL
   55 FORMAT('IDEBPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBAPLI(1)
   70 FORMAT('IBAPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBAPLI(I)
   76 FORMAT('I,IBAPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      IF(IHARG(5).EQ.'ALL')THEN
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBAPLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-3
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPL
      IBAPLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBAPLI(I)
 1276 FORMAT('THE LINE TYPE FOR BAR PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPL
      DO1315I=1,NUMBAR
      IBAPLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBAPLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL BAR PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBPL
 9015 FORMAT('IDEBPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBAPLI(1)
 9030 FORMAT('IBAPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBAPLI(I)
 9036 FORMAT('I,IBAPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBPSP(IHARG,IARGT,ARG,NUMARG,PDEBPS,MAXBAR,PBAPSP,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR PATTERN SPACINGS = THE SPACINGS
C              BETWEEN THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR PBAPSP(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEBPS
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PBAPSP (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PBAPSP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBP'
      ISUBN2='SP  '
C
      NUMBAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEBPS
   55 FORMAT('PDEBPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PBAPSP(1)
   70 FORMAT('PBAPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PBAPSP(I)
   76 FORMAT('I,PBAPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEBPS
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      PBAPSP(1)=PDEBPS
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBPS
      PBAPSP(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,PBAPSP(I)
 1276 FORMAT('THE SPACING BETWEEN (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBPS
      DO1315I=1,NUMBAR
      PBAPSP(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PBAPSP(I)
 1316 FORMAT('THE SPACING BETWEEN (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEBPS
 9015 FORMAT('PDEBPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PBAPSP(1)
 9030 FORMAT('PBAPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PBAPSP(I)
 9036 FORMAT('I,PBAPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBPTH(IHARG,IARGT,ARG,NUMARG,PDEBPT,MAXBAR,PBAPTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BAR PATTERN THICKNESSES = THE THICKNESSES
C              OF THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR PBAPTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEBPT
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PBAPTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PBAPTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBP'
      ISUBN2='TH  '
C
      NUMBAR=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDEBPT
   55 FORMAT('PDEBPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PBAPTH(1)
   70 FORMAT('PBAPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PBAPTH(I)
   76 FORMAT('I,PBAPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDEBPT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      PBAPTH(1)=PDEBPT
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBPT
      PBAPTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,PBAPTH(I)
 1276 FORMAT('THE THICKNESS OF (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEBPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEBPT
      DO1315I=1,NUMBAR
      PBAPTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PBAPTH(I)
 1316 FORMAT('THE THICKNESS OF (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDEBPT
 9015 FORMAT('PDEBPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PBAPTH(1)
 9030 FORMAT('PBAPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PBAPTH(I)
 9036 FORMAT('I,PBAPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBPTY(IHARG,NUMARG,IDEBPT,MAXBAR,IBAPTY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN TYPES = THE TYPES
C              OF THE PATTERN WITHIN THE BARS.
C              THESE ARE LOCATED IN THE VECTOR IBAPTY(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEBPT
C                     --MAXBAR
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IBAPTY (A CHARACTER VECTOR)
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  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEBPT
      CHARACTER*4 IBAPTY
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IBAPTY(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPBP'
      ISUBN2='TY  '
C
      NUMBAR=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXBAR,NUMBAR
   53 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEBPT
   55 FORMAT('IDEBPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)IBAPTY(1)
   70 FORMAT('IBAPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IBAPTY(I)
   76 FORMAT('I,IBAPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMBAR=1
      IBAPTY(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMBAR=NUMARG-2
      IF(NUMBAR.GT.MAXBAR)NUMBAR=MAXBAR
      DO1225I=1,NUMBAR
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPT
      IBAPTY(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMBAR
      WRITE(ICOUT,1276)I,IBAPTY(I)
 1276 FORMAT('THE TYPE FOR BAR PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMBAR=MAXBAR
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEBPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEBPT
      DO1315I=1,NUMBAR
      IBAPTY(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)IBAPTY(I)
 1316 FORMAT('THE TYPE FOR ALL BAR PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXBAR,NUMBAR
 9013 FORMAT('MAXBAR,NUMBAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEBPT
 9015 FORMAT('IDEBPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)IBAPTY(1)
 9030 FORMAT('IBAPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IBAPTY(I)
 9036 FORMAT('I,IBAPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBSCL(IHARG,NUMARG,IDBSCO,IBSPCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D BASEPLANE.
C              THE COLOR FOR THE BASEPLANE WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBSPCO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBSCO
C     OUTPUT ARGUMENTS--IBSPCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BASEPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBSCO
      CHARACTER*4 IBSPCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IBSPCO=IDBSCO
      GOTO1180
C
 1160 CONTINUE
      IBSPCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBSPCO
 1181 FORMAT('THE (3-D) BASEPLANE COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBSGC(IHARG,NUMARG,IDBSGC,IBSPGC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D BASEPLANE GRID.
C              THE COLOR FOR THE BASEPLANE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBSPGC.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBSGC
C     OUTPUT ARGUMENTS--IBSPGC
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BASEPLANE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBSGC
      CHARACTER*4 IBSPGC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IBSPGC=IDBSGC
      GOTO1180
C
 1160 CONTINUE
      IBSPGC=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBSPGC
 1181 FORMAT('THE (3-D) BASEPLANE GRID COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBSGP(IHARG,NUMARG,IDBSGP,IBSPGP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR THE 3-D BASEPLANE GRID.
C              THE PATTERN FOR THE BASEPLANE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IBSPGP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDBSGP
C     OUTPUT ARGUMENTS--IBSPGP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BASEPLANE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBSGP
      CHARACTER*4 IBSPGP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1160
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1150 CONTINUE
      IBSPGP='SOLI'
      GOTO1180
C
 1160 CONTINUE
      IBSPGP='BLAN'
      GOTO1180
C
 1170 CONTINUE
      IBSPGP=IDBSGP
      GOTO1180
C
 1175 CONTINUE
      IBSPGP=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IBSPGP
 1181 FORMAT('THE (3-D) BASEPLANE GRID PATTERN ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBSGR(IHARG,NUMARG,IDBSGR,IBSPGR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D BASEPLANE GRID SWITCH IBSPGR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDBSGR
C     OUTPUT ARGUMENTS--IBSPGR   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BASEPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDBSGR
      CHARACTER*4 IBSPGR
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1199
C
 1150 CONTINUE
      IBSPGR='ON'
      GOTO1180
C
 1160 CONTINUE
      IBSPGR='OFF'
      GOTO1180
C
 1170 CONTINUE
      IBSPGR=IDBSGR
      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)IBSPGR
 1181 FORMAT('THE (3-D) BASEPLANE GRID SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBSP(IHARG,NUMARG,IBSPSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D BASEPLANE SWITCH IBSPSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IBSPSW   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS BASEPLANE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IBSPSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IBSPSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IBSPSW='OFF'
      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)IBSPSW
 1181 FORMAT('THE (3-D) BASEPLANE SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPBSHW(IHARG,IARGT,IARG,ARG,NUMARG,PDEFSH,PDEFSW,
     1MAXBOX,PBOSHE,PBOSWI,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SHADOW HEIGHT & WIDTH FOR A BOX.
C              THE SHADOW HEIGHT & WIDTH FOR A BOX IS THE THICKNESS
C              OF THE SHADOW THAT WILL APPEAR BELOW AND TO THE RIGHT
C              OF THE BOX.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFSH
C                     --PDEFSW
C                     --MAXBOX
C     OUTPUT ARGUMENTS--PBOSHE (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              SHADOW HEIGHT FOR BOX I)
C                     --PBOSWI (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              SHADOW WIDTH FOR BOX I)
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     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--92/9
C     ORIGINAL VERSION--AUGUST    1992.
C     UPDATED         --DECEMBER  1999. ADD "OFF" OPTION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFSH
      REAL        PDEFSW
      REAL        PBOSHE
      REAL        PBOSWI
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLDH
      REAL        PHOLDW
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PBOSHE(*)
      DIMENSION PBOSWI(*)
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               **  STEP 1--                                    **
C               **  TREAT THE BOX SHADOW HEIGHT           CASE  **
C               **************************************************
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'SHAD')THEN
            IF(IHARG(2).EQ.'HEIG')THEN
               IF(NUMARG.EQ.2)THEN
                  PHOLDH=PDEFSH
                  GOTO1100
               ELSE IF(IHARG(3).EQ.'ON'.OR.
CCCCC1         IHARG(3).EQ.'OFF'.OR.
     1         IHARG(3).EQ.'AUTO'.OR.
     1         IHARG(3).EQ.'DEFA')THEN
                  PHOLDH=PDEFSH
                  GOTO1100
               ELSE IF(IHARG(3).EQ.'OFF')THEN
                  PHOLDH=0.0
                  GOTO1100
               ELSE IF(IHARG(3).EQ.'?')THEN
                  GOTO1150
               ELSE
                  PHOLDH=ARG(3)
                  GOTO1100
               ENDIF
            ELSEIF(IHARG(2).EQ.'OFF')THEN
              PHOLDH=0.0
              GOTO3100
            ENDIF
         ENDIF
      ENDIF
      GOTO1190
C
 1100 CONTINUE
      IFOUND='YES'
      DO1110I=1,MAXBOX
         PBOSHE(I)=PHOLDH
 1110 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)PBOSHE(1)
 1130 FORMAT('ALL BOX SHADOW HEIGHTS ',
     1'HAVE JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1160)PBOSHE(1)
 1160 FORMAT('ALL BOX SHADOW HEIGHTS ',
     1'HAVE THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1190 CONTINUE
C
C               **************************************************
C               **  STEP 2--                                    **
C               **  TREAT THE BOX SHADOW WIDTH            CASE  **
C               **************************************************
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'SHAD')THEN
            IF(IHARG(2).EQ.'WIDT')THEN
               IF(NUMARG.EQ.2)THEN
                  PHOLDW=PDEFSW
                  GOTO2100
               ELSE IF(IHARG(3).EQ.'ON'.OR.
CCCCC1         IHARG(3).EQ.'OFF'.OR.
     1         IHARG(3).EQ.'AUTO'.OR.
     1         IHARG(3).EQ.'DEFA')THEN
                  PHOLDW=PDEFSW
                  GOTO2100
               ELSE IF(IHARG(3).EQ.'OFF')THEN
                  PHOLDW=0.0
                  GOTO2100
               ELSE IF(IHARG(3).EQ.'?')THEN
                  GOTO2150
               ELSE
                  PHOLDW=ARG(3)
                  GOTO2100
               ENDIF
            ENDIF
         ENDIF
      ENDIF
      GOTO2190
C
 2100 CONTINUE
      IFOUND='YES'
      DO2110I=1,MAXBOX
         PBOSWI(I)=PHOLDW
 2110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2130)PBOSWI(1)
 2130 FORMAT('ALL BOX SHADOW WIDTHS  ',
     1'HAVE JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 2150 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2160)PBOSWI(1)
 2160 FORMAT('ALL BOX SHADOW WIDTHS  ',
     1'HAVE THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 2190 CONTINUE
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  TREAT THE BOX SHADOW HEIGHT AND WIDTH CASE  **
C               **************************************************
C
      IF(NUMARG.GE.2)THEN
         IF(IHARG(1).EQ.'SHAD')THEN
            IF(IHARG(2).EQ.'HW')THEN
               IF(NUMARG.EQ.2)THEN
                  PHOLDH=PDEFSH
                  PHOLDW=PDEFSW
                  GOTO3100
               ELSE IF(IHARG(3).EQ.'ON'.OR.
CCCCC1         IHARG(3).EQ.'OFF'.OR.
     1         IHARG(3).EQ.'AUTO'.OR.
     1         IHARG(3).EQ.'DEFA')THEN
                  PHOLDH=PDEFSH
                  PHOLDW=PDEFSW
                  GOTO3100
               ELSE IF(IHARG(3).EQ.'OFF')THEN
                  PHOLDH=0.0
                  PHOLDW=0.0
                  GOTO3100
               ELSE IF(IHARG(3).EQ.'?')THEN
                  GOTO3150
               ELSE
                  PHOLDH=ARG(3)
                  IF(NUMARG.LE.3)PHOLDW=ARG(3)
                  IF(NUMARG.GE.4)PHOLDW=ARG(4)
                  GOTO3100
               ENDIF
            ELSEIF(IHARG(2).EQ.'HW')THEN
              PHOLDH=0.0
              PHOLDW=0.0
              GOTO3100
            ENDIF
         ENDIF
      ENDIF
      GOTO3190
C
 3100 CONTINUE
      IFOUND='YES'
      DO3110I=1,MAXBOX
         PBOSHE(I)=PHOLDH
         PBOSWI(I)=PHOLDW
 3110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3131)PBOSHE(1)
 3131 FORMAT('ALL BOX SHADOW HEIGHTS ',
     1'HAVE JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3132)PBOSWI(1)
 3132 FORMAT('ALL BOX SHADOW WIDTHS  ',
     1'HAVE JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 3150 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3161)PBOSHE(1)
 3161 FORMAT('ALL BOX SHADOW HEIGHTS ',
     1'HAVE THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3162)PBOSWI(1)
 3162 FORMAT('ALL BOX SHADOW WIDTHS  ',
     1'HAVE THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 3190 CONTINUE
C
C               **************************************************
C               **  STEP 4--                                    **
C               **  TREAT THE BOX ... SHADOW HEIGHT       CASE  **
C               **************************************************
C
      IF(NUMARG.GE.3)THEN
CCCCC    IF(IHARG(1).EQ.'SHAD')THEN
         IF(IHARG(2).EQ.'SHAD')THEN
            IF(IHARG(3).EQ.'HEIG')THEN
               IF(NUMARG.EQ.3)THEN
                  PHOLDH=PDEFSH
                  GOTO4100
               ELSE IF(IHARG(4).EQ.'ON'.OR.
CCCCC1         IHARG(4).EQ.'OFF'.OR.
     1         IHARG(4).EQ.'AUTO'.OR.
     1         IHARG(4).EQ.'DEFA')THEN
                  PHOLDH=PDEFSH
                  GOTO4100
               ELSE IF(IHARG(4).EQ.'OFF')THEN
                  PHOLDH=0.0
                  GOTO4100
               ELSE IF(IHARG(4).EQ.'?')THEN
                  GOTO4150
               ELSE
                  PHOLDH=ARG(4)
                  GOTO4100
               ENDIF
            ENDIF
         ENDIF
      ENDIF
      GOTO4190
C
 4100 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4110)I,PBOSHE(1)
 4110       FORMAT('THE SHADOW HEIGHT FOR BOX ',I8,
     1      ' HAS JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 4150 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,4160)I,PBOSHE(I)
 4160       FORMAT('THE SHADOW HEIGHT FOR BOX ',I8,
     1      ' HAS THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 4190 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  TREAT THE BOX ... SHADOW WIDTH        CASE  **
C               **************************************************
C
      IF(NUMARG.GE.3)THEN
CCCCC    IF(IHARG(1).EQ.'SHAD')THEN
         IF(IHARG(2).EQ.'SHAD')THEN
            IF(IHARG(3).EQ.'WIDT')THEN
               IF(NUMARG.EQ.3)THEN
                  PHOLDW=PDEFSW
                  GOTO5100
               ELSE IF(IHARG(4).EQ.'ON'.OR.
CCCCC1         IHARG(4).EQ.'OFF'.OR.
     1         IHARG(4).EQ.'AUTO'.OR.
     1         IHARG(4).EQ.'DEFA')THEN
                  PHOLDW=PDEFSW
                  GOTO5100
               ELSE IF(IHARG(4).EQ.'OFF')THEN
                  PHOLDW=0.0
                  GOTO5100
               ELSE IF(IHARG(4).EQ.'?')THEN
                  GOTO5150
               ELSE
                  PHOLDW=ARG(4)
                  GOTO5100
               ENDIF
            ENDIF
         ENDIF
      ENDIF
      GOTO5190
C
 5100 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            PBOSWI(I)=PHOLDW
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5110)I,PBOSWI(1)
 5110       FORMAT('THE SHADOW WIDTH  FOR BOX ',I8,
     1      ' HAS JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 5150 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,5160)I,PBOSWI(I)
 5160       FORMAT('THE SHADOW WIDTH  FOR BOX ',I8,
     1      ' HAS THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 5190 CONTINUE
C
C               **************************************************
C               **  STEP 6--                                    **
C               **  TREAT THE BOX ... SHADOW HEIGHT & WIDTH CASE**
C               **************************************************
C
      IF(NUMARG.GE.3)THEN
CCCCC    IF(IHARG(1).EQ.'SHAD')THEN
         IF(IHARG(2).EQ.'SHAD')THEN
            IF(IHARG(3).EQ.'HW')THEN
               IF(NUMARG.EQ.3)THEN
                  PHOLDH=PDEFSH
                  PHOLDW=PDEFSW
                  GOTO6100
               ELSE IF(IHARG(4).EQ.'ON'.OR.
CCCCC1         IHARG(4).EQ.'OFF'.OR.
     1         IHARG(4).EQ.'AUTO'.OR.
     1         IHARG(4).EQ.'DEFA')THEN
                  PHOLDH=PDEFSH
                  PHOLDW=PDEFSW
                  GOTO6100
               ELSE IF(IHARG(4).EQ.'OFF')THEN
                  PHOLDH=PDEFSH
                  PHOLDW=PDEFSW
                  GOTO6100
               ELSE IF(IHARG(4).EQ.'?')THEN
                  GOTO6150
               ELSE
                  PHOLDH=ARG(4)
                  IF(NUMARG.LE.4)PHOLDW=ARG(4)
                  IF(NUMARG.GE.5)PHOLDW=ARG(5)
                  GOTO6100
               ENDIF
            ELSEIF(IHARG(3).EQ.'OFF')THEN
              PHOLDH=PDEFSH
              PHOLDW=PDEFSW
              GOTO6100
            ENDIF
         ENDIF
      ENDIF
      GOTO6190
C
 6100 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            PBOSHE(I)=PHOLDH
            PBOSWI(I)=PHOLDW
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6110)I,PBOSHE(1)
 6110       FORMAT('THE SHADOW HEIGHT FOR BOX ',I8,
     1      ' HAS JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6120)I,PBOSWI(1)
 6120       FORMAT('THE SHADOW WIDTH  FOR BOX ',I8,
     1      ' HAS JUST BEEN SET TO ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 6150 CONTINUE
      IF(IARGT(1).EQ.'NUMB')THEN
         I=IARG(1)
         IF(1.LE.I.AND.I.LE.MAXBOX)THEN
            IFOUND='YES'
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6161)I,PBOSHE(I)
 6161       FORMAT('THE SHADOW HEIGHT FOR BOX ',I8,
     1      ' HAS THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,6162)I,PBOSWI(I)
 6162       FORMAT('THE SHADOW WIDTH  FOR BOX ',I8,
     1      ' HAS THE CURRENT VALUE ',F10.4)
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ELSE
            GOTO8200
         ENDIF
      ENDIF
      GOTO8100
C
 6190 CONTINUE
      GOTO9000
C
C               **************************************************
C               **  STEP 11--                                   **
C               **  WRITE OUT MESSAGES FOR ERROR CONDITIONS
C               **************************************************
C
 8100 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)
 8111 FORMAT('***** ERROR IN DPBSHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)
 8112 FORMAT('      IN THE BOX ... HEIGHT COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)
 8113 FORMAT('      IN THE BOX ... WIDTH  COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8114)
 8114 FORMAT('      IN THE BOX ... HW COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8115)
 8115 FORMAT('      THE BOX MUST BE IDENTIFIED BY A NUMBER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8116)
 8116 FORMAT('      AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8117)
 8117 FORMAT('      BOX 3 HW 1 .8')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 8200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8211)
 8211 FORMAT('***** ERROR IN DPBSHW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8212)
 8212 FORMAT('      IN THE BOX ... HEIGHT COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8213)
 8213 FORMAT('      IN THE BOX ... WIDTH  COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8214)
 8214 FORMAT('      IN THE BOX ... HW COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8216)
 8216 FORMAT('      THE NUMBER OF BOXES MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8217)MAXBOX
 8217 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8218)
 8218 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8219)I
 8219 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'BOX.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPBTES(XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT BARTLETT TEST
C              (K-SAMPLE HOMOGENEITY OF VARIANCES)
C     EXAMPLE--BARTLETT TEST Y X
C     REFERENCE--DIXON & MASSEY, PAGE 179-180
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/12
C     ORIGINAL VERSION--DECEMBER  1994.
C     UPDATED         --MAY       1995.  BUG FIX
C     UPDATED         --AUGUST    1999.  CHANGE DEFINITION TO USE
C                                        MORE COMMONLY ACCEPTED 
C                                        FORM.  ADD "DIXON BARTLETT
C                                        TEST" TO USE PREVIOUS
C                                        DEFINITION.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
CCCCC MAY 1995.  ADD FOLLOWING DECLARATIONS
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION 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='DPBT'
      ISUBN2='ES  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               **************************************
C               **  TREAT THE BARTLETT 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 DPBTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPBTES--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR BARTLETT TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH)
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  IF ARGUMENT 1 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1)  **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPBTES--')
      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 BARTLETT TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN DPBTES--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR BARTLETT TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH)
 2150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.     **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.EQ.N1)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPBTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR VARIABLE 2 OF BARTLETT TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      MUST BE THE SAME AS VARIABLE 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)N1,N2
 2216 FORMAT('      N1 = ',I8,' N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPBTES--')
      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 BARTLETT TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATAN FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPBTES--')
      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 BARTLETT TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  DO BARTLETT 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 DPBTES, AS WE ARE ABOUT TO CALL DPTTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPBTE2(Y,X,NS1,
     1XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1STATVA,STANU1,STANU2,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
CCCCC MAY 1995.  FIX FOLLOWING LINE
CCCCC IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPBT'
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='NU1 '
      VALUE0=STANU1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='NU2 '
      VALUE0=STANU2
      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 DPBTES--')
      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 DPBTE2(Y,TAG,N,
     1XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1STATVA,STANU1,STANU2,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT BARTLETT'S TEST
C              (K-SAMPLE HOMOSCEDASTICITY TEST)
C     EXAMPLE--BARTLETT'S TEST Y TAG
C     REFERENCE--DIXON & MASSEY, PAGE 179-180
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/2
C     ORIGINAL VERSION--FEBRUARY  1994.
C     UPDATED         --AUGUST    1999.  ADD NEW DEFINITION
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION DTAG(1000)
      DIMENSION YTEMP(1000)
      DIMENSION ANI(1000)
      DIMENSION VARI(1000)
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='DPBT'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPBTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N
   65 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N
      WRITE(ICOUT,67)I,TAG(I)
   67 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPBTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPBTE2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPBTE2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPBTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPBTE2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=TAG(1)
      DO1235I=2,N
      IF(TAG(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPBTE2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
      IF(ICASAN.EQ.'DMBT')GOTO4100
      GOTO5100
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR    BARTLETT'S TEST  **
C               **  DIXON-MASSEY DEFINITION **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR)
C
      KPRIME=0
      NPRIME=0
      DO4200IDIS=1,NUMDIS
         J=0
         DO4300I=1,N
            IF(TAG(I).EQ.DTAG(IDIS))THEN
               J=J+1
               YTEMP(J)=Y(I)
            ENDIF
 4300    CONTINUE
         ANI(IDIS)=J
         IF(J.GE.2)THEN
            KPRIME=KPRIME+1
            NPRIME=NPRIME+J
            CALL VAR(YTEMP,J,IWRITE,VARI(IDIS),IBUGA3,IERROR)
         ENDIF
 4200 CONTINUE
      ANPRIM=NPRIME
      AKPRIM=KPRIME
C
      TERM1=0.0
      TERM2=0.0
      TERM3=0.0
      DO4400IDIS=1,NUMDIS
         J=ANI(IDIS)+0.5
         IF(J.GE.2)THEN
            TERM1=TERM1+(ANI(IDIS)-1.0)*VARI(IDIS)
            TERM2=TERM2+(ANI(IDIS)-1.0)*ALOG(VARI(IDIS))
            TERM3=TERM3+(1.0/(ANI(IDIS)-1.0))
         ENDIF
 4400 CONTINUE
C
      ANUM=TERM1
      ADEN=NPRIME-KPRIME
      VARPOO=ANUM/ADEN
C
      AM=(ANPRIM-AKPRIM)*ALOG(VARPOO)-TERM2
C
      TERM4=1.0/(3.0*(AKPRIM-1.0))
      TERM5=1.0/(ANPRIM-AKPRIM)
      A=TERM4*(TERM3-TERM5)
C
      ANU1=AKPRIM-1.0
      NU1=ANU1+0.5
      ANU1=NU1
      STANU1=ANU1
C
      ANU2=(AKPRIM+1.0)/(A**2)
      NU2=ANU2+0.5
      ANU2=NU2
      STANU2=ANU2
C
      B=ANU2/(1.0-A+(2.0/ANU2))
C
      ANUM=ANU2*AM
      ADEN=ANU1*(B-AM)
      STATVA=ANUM/ADEN
C
      CALL FCDF(STATVA,NU1,NU2,STATCD)
      CUTL95=0.0
      CALL FPPF(.95,NU1,NU2,CUTU95)
      CUTL99=0.0
      CALL FPPF(.99,NU1,NU2,CUTU99)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
CCCCC IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC1='ACCEPT'
CCCCC IF(0.025.LE.STATCD.AND.STATCD.LE.0.975)ICONC2='ACCEPT'
CCCCC IF(0.050.LE.STATCD.AND.STATCD.LE.1.000)ICONC3='ACCEPT'
      IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC2='ACCEPT'
C
C               ******************************
C               **   STEP 42--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR   BARTLETT'S TEST  **
C               ******************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4211)
 4211 FORMAT(
     1'              BARTLETT TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4212)
 4212 FORMAT(
     1'        (DIXON-MASSEY DEFINITION)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4213)
 4213 FORMAT('HYPOTHESIS BEING TESTED--ALL SIGMA(I) ARE EQUAL')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,4241)
 4241 FORMAT('TEST:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4242)ANU1
 4242 FORMAT(3X,'DEG. OF FREEDOM (NUMER.)    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4243)ANU2
 4243 FORMAT(3X,'DEG. OF FREEDOM (DENOM.)    = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,4244)STATVA
 4244 FORMAT(3X,'TEST STATISTIC VALUE        = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4245)CUTU95
 4245 FORMAT(3X,'CUTOFF: 95% PERCENT POINT   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4246)CUTU99
 4246 FORMAT(3X,'CUTOFF: 99% PERCENT POINT   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4247)STATCD
 4247 FORMAT(3X,'F CDF VALUE                 = ',F11.6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,4259)
 4259 FORMAT('                NULL                   NULL')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4260)
 4260 FORMAT('  NULL          HYPOTHESIS             HYPOTHESIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4261)
 4261 FORMAT('  HYPOTHESIS    ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4262)ICONC2
 4262 FORMAT('ALL SIGMA EQUAL    (0.000,0.950)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 4290 CONTINUE
      GOTO9000
C
C               ******************************
C               **  STEP 51--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR    BARTLETT'S TEST  **
C               **  STANDARD     DEFINITION **
C               ******************************
C
 5100 CONTINUE
C
      ISTEPN='51'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(TAG,N,IWRITE,DTAG,NUMDIS,IBUGA3,IERROR)
C
      KPRIME=0
      NPRIME=0
      DO5200IDIS=1,NUMDIS
         J=0
         DO5300I=1,N
            IF(TAG(I).EQ.DTAG(IDIS))THEN
               J=J+1
               YTEMP(J)=Y(I)
            ENDIF
 5300    CONTINUE
         ANI(IDIS)=J
         IF(J.GE.2)THEN
            KPRIME=KPRIME+1
            NPRIME=NPRIME+J
            CALL VAR(YTEMP,J,IWRITE,VARI(IDIS),IBUGA3,IERROR)
         ENDIF
 5200 CONTINUE
      ANPRIM=NPRIME
      AKPRIM=KPRIME
C
      TERM1=0.0
      TERM2=0.0
      TERM3=0.0
      DO5400IDIS=1,NUMDIS
         J=ANI(IDIS)+0.5
         IF(J.GE.2)THEN
            TERM1=TERM1+(ANI(IDIS)-1.0)*VARI(IDIS)
            TERM2=TERM2+(ANI(IDIS)-1.0)*ALOG(VARI(IDIS))
            TERM3=TERM3+(1.0/(ANI(IDIS)-1.0))
         ENDIF
 5400 CONTINUE
C
      ANUM=TERM1
      ADEN=NPRIME-KPRIME
      VARPOO=ANUM/ADEN
C
      AM=(ANPRIM-AKPRIM)*ALOG(VARPOO)-TERM2
C
      TERM4=1.0/(3.0*(AKPRIM-1.0))
      TERM5=1.0/(ANPRIM-AKPRIM)
      A=TERM4*(TERM3-TERM5)
      C=1.0 + A
C
      ANU1=AKPRIM-1.0
      NU1=ANU1+0.5
      ANU1=NU1
      STANU1=ANU1
C
      ANU2=0.0
      NU2=0
      STANU2=ANU2
C
      STATVA=AM/C
C
      CALL CHSCDF(STATVA,NU1,STATCD)
      CUTL95=0.0
      CALL CHSPPF(.95,NU1,CUTU95)
      CUTL99=0.0
      CALL CHSPPF(.99,NU1,CUTU99)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
CCCCC IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC1='ACCEPT'
CCCCC IF(0.025.LE.STATCD.AND.STATCD.LE.0.975)ICONC2='ACCEPT'
CCCCC IF(0.050.LE.STATCD.AND.STATCD.LE.1.000)ICONC3='ACCEPT'
      IF(0.000.LE.STATCD.AND.STATCD.LE.0.950)ICONC2='ACCEPT'
C
C               ******************************
C               **   STEP 52--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR   BARTLETT'S TEST  **
C               ******************************
C
      ISTEPN='52'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5211)
 5211 FORMAT(
     1'              BARTLETT TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5212)
 5212 FORMAT(
     1'          (STANDARD DEFINITION)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5213)
 5213 FORMAT('NULL HYPOTHESIS UNDER TEST--ALL SIGMA(I) ',
     1'ARE EQUAL')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,5241)
 5241 FORMAT('TEST:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5242)ANU1
 5242 FORMAT(3X,'DEGREES OF FREEDOM          = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,5244)STATVA
 5244 FORMAT(3X,'TEST STATISTIC VALUE        = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5245)CUTU95
 5245 FORMAT(3X,'CUTOFF: 95% PERCENT POINT   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5246)CUTU99
 5246 FORMAT(3X,'CUTOFF: 99% PERCENT POINT   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5247)STATCD
 5247 FORMAT(3X,'CHI-SQUARE CDF VALUE        = ',F11.6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,5260)
 5260 FORMAT('  NULL          NULL HYPOTHESIS        NULL ',
     1'HYPOTHESIS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5261)
 5261 FORMAT('  HYPOTHESIS    ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,5262)ICONC2
 5262 FORMAT('ALL SIGMA EQUAL    (0.000,0.950)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 5290 CONTINUE
      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 DPBTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N
 9025 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N
      WRITE(ICOUT,9027)I,TAG(I)
 9027 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBUGS(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DISPLAY CONTENTS OF DATAPLOT BUGS 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--86/1
C     ORIGINAL VERSION--OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --APRIL     1992.  COMMENT OUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ISTRIN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPBU'
      ISUBN2='GS  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'BUGS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBUGS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992 (ALAN)
CCCCC WRITE(ICOUT,54)IWIDTH
CCC54 FORMAT('IWIDTH = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IBUGNU
   61 FORMAT('IBUGNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IBUGNA
   62 FORMAT('IBUGNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IBUGST
   63 FORMAT('IBUGST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IBUGFO
   64 FORMAT('IBUGFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IBUGAC
   65 FORMAT('IBUGAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IBUGFO
   66 FORMAT('IBUGFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)IBUGCS
   67 FORMAT('IBUGCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'BUGS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=IBUGNU
      IFILE=IBUGNA
      ISTAT=IBUGST
      IFORM=IBUGFO
      IACCES=IBUGAC
      IPROT=IBUGPR
      ICURST=IBUGCS
C
      ISUBN0='BUGS'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'BUGS')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ****************************************
C               **  STEP 12--                         **
C               **  CHECK TO SEE IF BUGS FILE EXISTS  **
C               ****************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'BUGS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPBUGS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED BUGS FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE LISTED BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES ANY BUGS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,IBUGST
 1217 FORMAT('ISTAT,IBUGST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'BUGS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ******************************
C               **  STEP 41--               **
C               **  READ THE FILE.          **
C               **  WRITE OUT THE BUGS.     **
C               ******************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'MESS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ANUMLI=0.0
      READ(IOUNIT,4111,END=4190)ANUMLI
 4111 FORMAT(F10.0)
      NUMLIN=ANUMLI+0.5
C
      IF(NUMLIN.LE.0)GOTO4190
      DO4120I=1,NUMLIN
      READ(IOUNIT,4121,END=4190)(ISTRIN(J:J),J=1,80)
 4121 FORMAT(80A1)
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(JMAX.GE.1)WRITE(ICOUT,4122)(ISTRIN(J:J),J=1,JMAX)
 4122 FORMAT(5X,80A1)
      IF(JMAX.GE.1)CALL DPWRST('XXX','BUG ')
      IF(JMAX.LE.0)WRITE(ICOUT,999)
      IF(JMAX.LE.0)CALL DPWRST('XXX','BUG ')
 4120 CONTINUE
 4190 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'BUGS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'BUGS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBUGS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IOUNIT
 9021 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFILE
 9022 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ISTAT
 9023 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IFORM
 9024 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IACCES
 9025 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IPROT
 9026 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICURST
 9027 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IENDFI
 9028 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IREWIN
 9029 FORMAT('IREWIN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISUBN0
 9031 FORMAT('ISUBN0 = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IERRFI
 9032 FORMAT('IERRFI = ',A12)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPBWCO(XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE (SYMMETRIC) CONFIDENCE LIMITS FOR THE MEAN
C              FOR PROBABILITY VALUE P = .90, .95, .99, .999, AND .9999.
C              BASED ON BIWEIGHT LOCATION AND SCALE ESTIMATES.
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     REFERENCE--"DATA ANALYSIS AND RGRESSION: A SECOND COURSE IN
C                STATISTICS", MOSTELLER AND TUKEY, ADDISON-WESLEY,
C                1977.
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/11
C     ORIGINAL VERSION--NOVEMBER  2001.
C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
C
      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
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
C
C-----COMMON----------------------------------------------------------
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='DPBW'
      ISUBN2='CO  '
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 BIWEIGHT CONFIDENCE LIMITS CASE  **
C               *************************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBWCO--')
      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 ')
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')
     1CALL 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'.OR.ISUBRO.EQ.'BWCO')
     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     **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS 2 OR MORE. **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')
     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 DPBWCO--')
      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 BIWEIGHT 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,MAX(IWIDTH,80))
  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'.OR.ISUBRO.EQ.'BWCO')
     1CALL 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'.OR.ISUBRO.EQ.'BWCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N2.GE.MINN2)GOTO419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('***** ERROR IN DPBWCO--')
      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 BIWEIGHT 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
  440 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'.OR.ISUBRO.EQ.'BWCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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'.OR.ISUBRO.EQ.'ON')
     1CALL 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'.OR.ISUBRO.EQ.'BWCO')
     1CALL 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 DPBWCO--')
      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 BIWEIGHT 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,MAX(IWIDTH,80))
  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 DPBWCO--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')
     1CALL 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'.OR.ISUBRO.EQ.'BWCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPBWCO, AS WE ARE ABOUT TO CALL DPBWC2--')
      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 ')
      ENDIF
C
C
      CALL DPBWC2(Y,W,NS,X,NS2,XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'BWCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBWCO--')
      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 DPBWC2(Y,W,N,X,N2,XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES BIWEIGHT CONFIDENCE LIMITS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
C     NOTE--WEIGHTS AND TWO VARIABLE (=DIFFERENCE OF TWO MEANS)
C           NOT YET SUPPORTED.  ARGUMENTS PASSED FOR POSSIBLE
C           FUTURE IMPLEMENTATION.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS
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--2001/11
C     ORIGINAL VERSION--NOVEMBER  2001.
C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX
C                                       OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 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='DPBW'
      ISUBN2='C2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BWC2')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPBWC2--')
      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')GOTO9000
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BWC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPBWC2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS LESS THAN 2')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
  119 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 DPBWC2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
  139 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE BIWEIGHT LOCATION ESTIMATE       **
C               **  COMPUTE THE BIWEIGHT SCALE ESTIMATE          **
C               **  COMPUTE THE SQRT(BIWEIGHT SCALE/N).          **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BWC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL BIWLOC(Y,N,IWRITE,XTEMP1,XTEMP2,MAXNXT,YBW,IBUGA3,IERROR)
      CALL BIWSCA(Y,N,IWRITE,XTEMP1,XTEMP2,MAXNXT,YBSC,IBUGA3,IERROR)
      AN1=N
      YSTERR=SQRT(YBSC/AN1)
C
      V=0.7*(AN1-1.0)
      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'.OR.ISUBRO.EQ.'BWC2')
     1CALL 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
      CALL TPPF(CDF,IV,T(I))
      TSDM(I)=T(I)*YSTERR
      ALOWER(I)=YBW-TSDM(I)
      AUPPER(I)=YBw+TSDM(I)
 1400 CONTINUE
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BWC2')
     1CALL 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('</PRE>')
 5004   FORMAT('<BR><BR>')
        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('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Confidence Limits for the Biweight ',
     1         'Location<BR>')
 5018   FORMAT('      (2-Sided)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5045   FORMAT('         Number of Observations:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5031   FORMAT('         ',G15.7)
 5033   FORMAT('         ',I8)
 5039   FORMAT('   </TR>')
 5051   FORMAT('         Biweight Location:')
 5052   FORMAT('         Biweight Scale:')
 5053   FORMAT('         Standard Error:')
 5054   FORMAT('         Degrees of Freedom:')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5033)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)YBW
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)YBSC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)YSTERR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5054)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5033)IV
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        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('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5131   FORMAT('         Confidence<BR>Value (%)')
 5132   FORMAT('         t<BR>Value')
 5133   FORMAT('         t X Standard Error)')
 5134   FORMAT('         Lower<br>Limit')
 5135   FORMAT('         Upper<br>Limit')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
        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('   <TR>')
 5143   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5147   FORMAT('      </TD>')
 5151   FORMAT('         ',F8.3)
 5152   FORMAT('         ',G12.6)
 5149   FORMAT('   </TR>')
        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('</TABLE>')
 5193   FORMAT('</UL>')
 5199   FORMAT('<PRE>')
        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 Biweight ',
     1      'Location (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,'Biweight Location: & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,'Biweight Scale: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Standard Error: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Degrees of Freedom: & ',I8,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)YBW,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)YBSC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)YSTERR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IV,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 Standard Error} & {',A1,'bf Limit} & {',A1,
     1       'bf Limit }',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
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,811)
  811   FORMAT(
     1'                   CONFIDENCE LIMITS FOR BIWEIGHT LOCATION')
        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)YBW
  822   FORMAT(
     1'          BIWEIGHT LOCATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,823)YBSC
  823   FORMAT(
     1'          BIWEIGHT SCALE             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,824)YSTERR
  824   FORMAT(
     1'          STANDARD ERROR             = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,826)IV
  826   FORMAT(
     1'          DEGREES OF FREEDOM         = ',I15)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,832)
  832   FORMAT(
     1'   CONFIDENCE   T     T X STDERR       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')
      ELSE
      ENDIF
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'BWC2')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBWC2--')
      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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPBX(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1IBOBPA,IBOBCO,PBOPTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
CCCCC MARCH 1993.  ADD PARAMETERS FOR BOX SHADOW
     1PBOSHE,PBOSWI,
     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 BOXES
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 BOX.
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 BOX 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 BOX 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 BOX 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         --JANUARY   1989.  USE COMMON PARAMETERS (ALAN)
C     UPDATED         --MARCH     1993. ADD BOX SHADOW, PATTERN LINE
C     UPDATED         --MARCH     1993. GLOBALLY RENAMED IBOFPA, IBOFCO
C                                       PBOFTH TO IBOBPA, IBOBCO, PBOPTH
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 IBOBPA
      CHARACTER*4 IBOBCO
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 IBOBPA(*)
      DIMENSION IBOBCO(*)
      DIMENSION PBOPTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
CCCCC MARCH 1993.  ADD FOLLOWING 2 LINES
      DIMENSION PBOSHE(*)
      DIMENSION PBOSWI(*)
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.'BX')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBX--')
      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)IBOBPA(1),IBOBCO(1),PBOPTH(1)
   61 FORMAT('IBOBPA(1),IBOBCO(1),PBOPTH(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='BOX'
      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 DPBX--')
      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 BOX ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE CORNER AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH OPPOSITE CORNER AT THE POINT 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('      BOX 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      BOX 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 DPBX2(X1,Y1,X2,Y2,
     1IFIG,
     1IBOBPA,IBOBCO,PBOPTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
CCCCC MARCH 1993.  ADD FOLLOWING LINE (BOX SHADOW)  (ALAN)
     1PBOSHE,PBOSWI,
     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.'BX')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBX--')
      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 DPBX2(X1,Y1,X2,Y2,
     1IFIG,
     1IBOBPA,IBOBCO,PBOPTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
CCCCC MARCH 1993.  BOX SHADOW PARAMETERS
     1PBOSHE,PBOSWI,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A BOX
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         --JANUARY   1989.  USE COMMON PARAMETERS (ALAN)
C     UPDATED         --MARCH     1993. BOX SHADOW, PATTERN LINE TYPE
C     UPDATED         --MARCH     1993. GLOBALLY RENAMED IBOFPA, IBOFCO
C                                       PBOFTH TO IBOBPA, IBOBCO, PBOPTH
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 IBOBPA
      CHARACTER*4 IBOBCO
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(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION IBOBPA(*)
      DIMENSION IBOBCO(*)
      DIMENSION PBOPTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
CCCCC MARCH 1993.  ADD FOLLOWING 2 LINES
      DIMENSION PBOSHE(*)
      DIMENSION PBOSWI(*)
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.'BX2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPBX2--')
      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)IBOBPA(1),IBOBCO(1),PBOPTH(1)
   61 FORMAT('IBOBPA(1),IBOBCO(1),PBOPTH(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 BOX                **
C               *********************************
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
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
CCCCC FOLLOWING BLOCK MODIFIED MARCH 1993.
CCCCC USE BOX PARAMETERS RATHER THAN REGION PARAMETERS.
CCCCC IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IF(IPATT.EQ.'OFF')GOTO2190
      IF(IPATT.EQ.'EMPT')GOTO2190
      IF(IPATT.EQ.'    ')GOTO2190
      IF(IPATT.EQ.'NONE')GOTO2190
      IF(IPATT.EQ.'BLAN')GOTO2190
      IF(IPATT.EQ.'BLAN')GOTO2190
      IF(IPATT.EQ.'ON')IPATT='SOLI'
CCCCC IPATT2='SOLI'
      IPATT2=IREPLI(1)
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
CCCCC ICOLF=IREFCO(1)
CCCCC ICOLP=IREPCO(1)
      ICOLF=IREPCO(1)
      ICOLP=ICOLF
      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=IBOBPA(1)
      PTHICK=PBOPTH(1)
      ICOL=IBOBCO(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
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED
CCCCC TO ADD A SHADOW TO THE BOX   MARCH 1993
C               ***************************
C               **  STEP 4--             **
C               **  DRAW THE BOX SHADOW  **
C               ***************************
C
C
      PSH=PBOSHE(1)
      PSW=PBOSWI(1)
      EPSBS=0.000001
      IF(PSH.LT.EPSBS.AND.PSW.LT.EPSBS)GOTO4190
      PLEFT=X1
      PRIGHT=X2
      IF(X2.LT.X1)THEN
         PLEFT=X2
         PRIGHT=X1
      ENDIF
      PBOTTO=Y1
      PTOP=Y2
      IF(Y2.LT.Y1)THEN
         PBOTTO=Y2
         PTOP=Y1
      ENDIF
      PX(1)=PLEFT+PSW
      PY(1)=PBOTTO-PSH
      PX(2)=PRIGHT+PSW
      PY(2)=PBOTTO-PSH
      PX(3)=PRIGHT+PSW
      PY(3)=PBOTTO
      PX(4)=PLEFT+PSW
      PY(4)=PBOTTO
      PX(5)=PLEFT+PSW
      PY(5)=PBOTTO-PSH
      NP=5
      IPATT='SOLI'
      IPATT2='SOLI'
      ICOLF=IBOBCO(1)
      ICOLP=ICOLF
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXSPA,PYSPA,ICOLF,ICOLP,IPATT2)
C
      PX(1)=PRIGHT
      PY(1)=PBOTTO-PSH
      PX(2)=PRIGHT+PSW
      PY(2)=PBOTTO-PSH
      PX(3)=PRIGHT+PSW
      PY(3)=PTOP-PSH
      PX(4)=PRIGHT
      PY(4)=PTOP-PSH
      PX(5)=PRIGHT
      PY(5)=PBOTTO-PSH
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXSPA,PYSPA,ICOLF,ICOLP,IPATT2)
C
 4190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'BX2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPBX2--')
      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,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
