      SUBROUTINE DPDIA2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A DIAMOND
C              WITH ONE END OF THE MAJOR AXIS AT (X1,Y1)
C              WITH ONE END OF THE MINOR AXIS AT (X2,Y2)
C              AND THE OTHER END OF MAJOR AXIS AT (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DIA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDIA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE DIAMOND            **
C               *********************************
C
      XC=(X1+X3)/2.0
      YC=(Y1+Y3)/2.0
C
      XDEL=XC-X2
      YDEL=YC-Y2
C
      X4=XC+XDEL
      Y4=YC+YDEL
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y2
C
      PX(3)=X3
      PY(3)=Y3
C
      PX(4)=X4
      PY(4)=Y4
C
      PX(5)=X1
      PY(5)=Y1
C
      NP=5
C
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL \PDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DIA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDIA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)XC,YC,XDEL,YDEL
 9012 FORMAT('XC,YC,XDEL,YDEL = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDIAL(IHARG,IARGT,IARG,NUMARG,
     1IGRASW,PDIAXC,PDIAYC,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--SWITCH THE TERMINAL INTO DIALOGUE (= NON-GRAPHICS) MODE
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON  D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--85/1
C     ORIGINAL VERSION--NOVEMBER  1984.
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C
C-----NON-COMMON VARIABLES----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IGRASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
C
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
C
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPDI'
      ISUBN2='AL  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IBUGG4=IBUGD2
      ISUBG4=ISUBRO
      IERRG4=IERROR
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPDIAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGD2,IBUGG4
   53 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IFOUND,IERROR
   54 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IGRASW,PDIAXC,PDIAYC
   55 FORMAT('IGRASW,PDIAXC,PDIAYC = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I),IARG(I)
   62 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      WRITE(ICOUT,70)NUMDEV
   70 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO71I=1,NUMDEV
      WRITE(ICOUT,72)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   72 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
   73 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
   74 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
      WRITE(ICOUT,82)IMANUF,IMODEL,IMODE2,IMODE3
   82 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IGCONT,IGCOLO
   83 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)NUMVPP,NUMHPP,ANUMVP,ANUMHP
   84 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  EXTRACT NEEDED INFORMATION FROM THE COMMAND LINE  **
C               ********************************************************
C
      IF(NUMARG.LE.0)GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ON')GOTO1110
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFF')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      IGRASW='OFF2'
      IFOUND='YES'
      GOTO1190
C
 1120 CONTINUE
      IGRASW='ON2'
      IFOUND='YES'
      GOTO1190
C
 1190 CONTINUE
C
C               ********************************
C               **  STEP 2--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               *************************************************
C               **  STEP 2.1--                                 **
C               **  TREAT THE DISCRETE TERMINALS CASE          **
C               *************************************************
C
      ISTEPN='2.1'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IGCONT.EQ.'OFF')GOTO8000
C
C               **************************************
C               **  STEP 2.2--                      **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  FOR CONTINUOUS TERMINALS        **
C               **************************************
C
 1200 CONTINUE
      ISTEPN='2.2'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IGRASW.EQ.'OFF2')GOTO1300
      GOTO1400
C
C               ****************************************
C               **  STEP 2.3--                        **
C               **  TREAT THE DIALOGUE MODE CASE      **
C               **  FOR CONTINUOUS TERMINALS.         **
C               ****************************************
C
 1300 CONTINUE
      ISTEPN='2.3'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1305)
 1305 FORMAT('*** FROM DPDIAL--ENTRY INTO DIALOGUE MODE ',
     1'SHOULD TAKE PLACE NOW')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      CALL GRSEMO(IGRASW,PDIAXC,PDIAYC)
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1306)
 1306 FORMAT('*** FROM DPDIAL--ENTRY INTO DIALOGUE MODE ',
     1'SHOULD HAVE JUST TAKEN PLACE')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      GOTO8000
C
C               ****************************************
C               **  STEP 2.4--                        **
C               **  TREAT THE GRAPHICS MODE CASE      **
C               **  FOR CONTINUOUS TERMINALS.         **
C               ****************************************
C
 1400 CONTINUE
      ISTEPN='2.4'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1405)
 1405 FORMAT('*** FROM DPDIAL--ENTRY INTO GRAPHICS MODE ',
     1'SHOULD TAKE PLACE NOW')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      CALL GRSEMO(IGRASW,PDIAXC,PDIAYC)
C
      IF(IBUGD2.EQ.'ON')WRITE(ICOUT,1206)
 1206 FORMAT('*** FROM DPDIAL--ENTRY INTO GRAPHICS MODE ',
     1'SHOULD HAVE JUST TAKEN PLACE')
      IF(IBUGD2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      GOTO8000
C
 8000 CONTINUE
      IF(IGRASW.EQ.'OFF2')IGRASW='OFF'
      IF(IGRASW.EQ.'ON2')IGRASW='ON'
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPDIAL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGD2,IBUGG4
 9013 FORMAT('IBUGD2,IBUGG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFOUND,IERROR
 9014 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IGRASW,PDIAXC,PDIAYC
 9015 FORMAT('IGRASW,PDIAXC,PDIAYC = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I),IARG(I)
 9022 FORMAT('I,IHARG(I),IARGT(I),IARG(I) = ',
     1I8,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
      WRITE(ICOUT,9030)NUMDEV
 9030 FORMAT('NUMDEV = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9031I=1,NUMDEV
      WRITE(ICOUT,9032)I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
 9032 FORMAT('I,IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)I,IDPOWE(I),IDCONT(I),IDCOLO(I)
 9033 FORMAT('I,IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)I,IDNVPP(I),IDNHPP(I),IDUNIT(I)
 9034 FORMAT('I,IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,2X,I8,2X,I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
 9031 CONTINUE
      WRITE(ICOUT,9042)IMANUF,IMODEL,IMODE2,IMODE3
 9042 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IGCONT,IGCOLO
 9043 FORMAT('IGCONT,IGCOLO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)NUMVPP,NUMHPP,ANUMVP,ANUMHP
 9044 FORMAT('NUMVPP,NUMHPP,ANUMVP,ANUMHP = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDIAM(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE DIAMONDS
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 3 SUCCESSIVE POINTS
C           AROUND THE DIAMOND.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN DIAMOND WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS)
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE DIAMOND.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN DIAMOND WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT ONE END OF MAJOR AXIS),
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           (ASSUMED TO BE AT ONE END OF MINOR AXIS),
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C           (ASSUMED TO BE AT THE OTHER END OF MAJOR AXIS),
C           AND THEN BACK TO THE OTHER END OF THE MINOR AXIS,
C           AND CONTINUING BACK THE START POINT TO CLOSE THE DIAMOND.
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... 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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     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.  SEP. UNITS FOR GR & ALPHA I/O (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DIAM')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDIAM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='DIAM'
      NUMPT=3
      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 DPDIAM--')
      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 AN DIAMOND ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END OF MAJOR AXIS AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      ONE END OF THE MINOR AXIS AT THE POINT 30 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('      AND WITH THE OTHER END OF THE MAJOR AXIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('      AT THE POINT 40 20')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      DIAMOND 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      DIAMOND ABSOLUTE 20 20 30 10 40 20 ')
      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
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y3,Y3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPDIA2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
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.'DIAM')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDIAM--')
      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,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.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 DPDIME(IHARG,IARGT,IARG,NUMARG,IDEMXN,IDEMXC,
     1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM,
     1V,MAXNK,NUMN,MAXN,MAXNXT,
CCCCC JANUARY 1998.  ADD FOLLOWING LINE.
     1MAXTOM,MAXROM,MAXCOM,MAXOBV,
     1NUMCOL,MAXCOL,IFOUND,IERROR,IBUGS2)
C
C     PURPOSE--DEFINE THE MAXIMUM NUMBER OF ROWS (MAXN)
C              AND COLUMNS (MAXCOL) IN THE INTERNAL DATAPLOT
C              DATA ARRAY.
C              THE MAXIMUM NUMBER OF ROWS WILL BE PLACED
C              IN THE VARIABLE MAXN.
C              THE MAXIMUM NUMBER OF COLUMNS WILL BE PLACED
C              IN THE VARIABLE MAXCOL.
C              NOTE THAT THE PRODUCT OF MAXN AND MAXCOL SHOULD
C              NOT EXCEED THE VALUE OF MAXNK.
C              MAXNK DIFFERS AT DIFFERENT COMPUTER
C              INSTALLATIONS DEPENDENDING ON AVAILABLE MEMORY.
C              A TYPICAL VALUE FOR MAXNK IS 10000    .
C              MAXNK IS DEFINED IN THE SUBROUTINE INITDA.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEMXN (AN INTEGER VARIABLE)
C                     --IDEMXC (AN INTEGER VARIABLE)
C                     --IHNAME (A  HOLLERITH VECTOR)
C                     --IHNAM2 (A  HOLLERITH VECTOR)
C                     --IUSE   (A  HOLLERITH VECTOR)
C                     --IN     (AN INTEGER VECTOR)
C                     --IVSTAR (AN INTEGER VECTOR)
C                     --IVSTOP (AN INTEGER VECTOR)
C                     --IVALUE (AN INTEGER VECTOR)
C                     --VALUE  (A  FLOATING POINT VECTOR)
C                     --NUMNAM (AN INTEGER VARIABLE)
C                     --MAXNAM (AN INTEGER VARIABLE)
C                     --V      (A  FLOATING POINT VECTOR)
C                     --MAXNK  (AN INTEGER VARIABLE)
C                     --NUMN   (AN INTEGER VARIABLE)
C                     --NUMCOL (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--MAXN   (AN INTEGER VARIABLE
C                              WHICH SPECIFIES THE MAXIMUM
C                              NUMBER OF ROWS FOR A GIVEN COLUMN
C                              (THAT IS, THE MAXIMUM NUMBER OF
C                              OBSERVATIONS FOR A GIVEN VARIABLE).
C                     --MAXCOL (AN INTEGER VARIABLE
C                              WHICH SPECIFIES THE MAXIMUM
C                              NUMBER OF COLUMNS
C                              (THAT IS, THE MAXIMUM NUMBER OF
C                              VARIABLES)
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1985.
C     UPDATED         --JUNE      1989.  ALLOW   FACTOR
C     UPDATED         --JULY      1989.  MAXCP1/2/3/4/5/6
C     UPDATED         --OCTOBER   1991.  MOVE COMMENT LINE
C     UPDATED         --JANUARY   1998.  ADD DIMENSION MATRIX
C                                        <ROWS/COLUMNS> <VALUE>
C     UPDATED         --JULY      1998.  SAVE AS INTERNAL PARAMETERS:
C                                          MAXROWS, MAXCOLS
C                                          MAXROWMT, MAXCOLMT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IBUGS2
C
      CHARACTER*4 ITRUND
      CHARACTER*4 ITRUNV
      CHARACTER*4 IDONE
C
      CHARACTER*1 IANS
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVSTAR(*)
      DIMENSION IVSTOP(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION V(*)
C
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
      INCLUDE 'DPCOM2.INC'
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1998
      INCLUDE 'DPCOHO.INC'
 
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='YES'
      IERROR='NO'
C
      ISUBN0='DIME'
      IANS=' '
      IWIDTH=1
C
      ITEMPR=(-999)
      ITEMPC=(-999)
      ITEMRC=(-999)
C
      MINR=MAXNK/MAXNAM
      MAXR=MAXNXT
C
      MINC=MAXNK/MAXNXT
      MAXC=MAXNAM
C
      MINRC=1
      MAXRC=MAXNK
C
      NNEW=0
      IV1NEW=0
      IV2NEW=0
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2
   52 FORMAT('IBUGS2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMNAM,MAXNAM
   53 FORMAT('NUMNAM,MAXNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXNK
   54 FORMAT('MAXNK = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMN,MAXN,MAXNXT
   55 FORMAT('NUMN,MAXN,MAXNXT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMCOL,MAXCOL
   56 FORMAT('NUMCOL,MAXCOL = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)MINR,MAXR,MINC,MAXC,MINRC,MAXRC
   57 FORMAT('MINR,MAXR,MINC,MAXC,MINRC,MAXRC = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),',
     1'IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)')
      CALL DPWRST('XXX','BUG ')
      IF(NUMNAM.LE.0)GOTO64
      DO62I=1,NUMNAM
      WRITE(ICOUT,63)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),
     1IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)
   63 FORMAT(I8,2X,A4,2X,A4,2X,A4,4I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   64 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE THE DESIRED DIMENSIONS  **
C               ****************************************
C
      IF(NUMARG.LE.1)GOTO1130
C
CCCCC JANUARY 1998.  ADD FOLLOWING FOR MATRIX DIMENSIONS
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MATR')THEN
        IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLU')THEN
          IF(NUMARG.GE.3.AND.IARGT(3).EQ.'NUMB')THEN
            MAXCOM=IARG(3)
            IF(MAXCOM.GT.SQRT(REAL(MAXTOM)))MAXCOM=SQRT(REAL(MAXTOM))
            IF(MAXCOM.LT.MAXTOM/MAXOBV)MAXCOM=MAXTOM/MAXOBV
            MAXROM=MAXTOM/MAXCOM
            IF(MAXROM.GT.MAXN)MAXROM=MAXN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,901)MAXROM
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,902)MAXCOM
            CALL DPWRST('XXX','BUG ')
            GOTO950
          ELSE
            GOTO990
          ENDIF
        ELSEIF(NUMARG.GE.3.AND.IHARG(3).EQ.'COLU')THEN
          IF(IARGT(2).EQ.'NUMB')THEN
            MAXCOM=IARG(2)
            IF(MAXCOM.GT.SQRT(REAL(MAXTOM)))MAXCOM=SQRT(REAL(MAXTOM))
            IF(MAXCOM.LT.MAXTOM/MAXOBV)MAXCOM=MAXTOM/MAXOBV
            MAXROM=MAXTOM/MAXCOM
            IF(MAXROM.GT.MAXN)MAXROM=MAXN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,901)MAXROM
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,902)MAXCOM
            CALL DPWRST('XXX','BUG ')
            GOTO950
          ELSE
            GOTO990
          ENDIF
        ELSEIF(NUMARG.GE.2.AND.IHARG(2)(1:3).EQ.'ROW')THEN
          IF(NUMARG.GE.3.AND.IARGT(3).EQ.'NUMB')THEN
            MAXROM=IARG(3)
            IF(MAXROM.GT.MAXOBV)MAXROM=MAXOBV
            IF(MAXROM.LT.SQRT(REAL(MAXTOM)))MAXROM=SQRT(REAL(MAXTOM))
            IF(MAXROM.GT.MAXN)MAXROM=MAXN
            MAXCOM=MAXTOM/MAXROM
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,901)MAXROM
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,902)MAXCOM
            CALL DPWRST('XXX','BUG ')
            GOTO950
          ELSE
            GOTO990
          ENDIF
        ELSEIF(NUMARG.GE.3.AND.IHARG(3)(1:3).EQ.'ROW')THEN
          IF(IARGT(2).EQ.'NUMB')THEN
            MAXROM=IARG(2)
            IF(MAXROM.GT.MAXOBV)MAXROM=MAXOBV
            IF(MAXROM.LT.SQRT(REAL(MAXTOM)))MAXROM=SQRT(REAL(MAXTOM))
            IF(MAXROM.GT.MAXN)MAXROM=MAXN
            MAXCOM=MAXTOM/MAXROM
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,901)MAXROM
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,902)MAXCOM
            CALL DPWRST('XXX','BUG ')
            GOTO950
          ELSE
            GOTO990
          ENDIF
        ELSE
          GOTO990
        ENDIF
      ENDIF
      GOTO980
C
  950 CONTINUE
      IH='MAXR'
      IH2='OWMT'
      VALUE0=MAXROM
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGS2,IERROR)
C
      IH='MAXC'
      IH2='OLMT'
      VALUE0=MAXCOM
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGS2,IERROR)
C
      GOTO9000
C
  901 FORMAT('THE MAXIMUM NUMBER OF MAXTRIX ROWS    SET TO ',I5)
  902 FORMAT('THE MAXIMUM NUMBER OF MAXTRIX COLUMNS SET TO ',I5)
C
  980 CONTINUE
      IF(NUMARG.LE.2.AND.IARGT(1).EQ.'NUMB'.AND.
     1IARGT(2).EQ.'NUMB')GOTO1140
      IF(NUMARG.LE.2.AND.IARGT(1).EQ.'NUMB'.AND.
     1IARGT(2).NE.'NUMB')GOTO1150
C
      IF(NUMARG.LE.4.AND.IARGT(1).EQ.'NUMB'.AND.
     1IARGT(2).NE.'NUMB'.AND.IARGT(3).EQ.'NUMB'.AND.
     1IARGT(4).NE.'NUMB')GOTO1160
C
  990 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      ILLEGAL FORM FOR THE DIMENSION COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      RECOMMENDED FORMS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('         DIMENSION 1000 OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('         DIMENSION 10 VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('      OTHER ALLOWABLE FORMS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('         DIMENSION 1000 ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('         DIMENSION 10 COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('         DIMENSION 1000 OBSERVATIONS 10 VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('         DIMENSION 10 VARIABLES 1000 OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('         DIMENSION 1000 ROWS 10 COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('         DIMENSION 10 COLUMNS 1000 ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('         DIMENSION 1000 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1130 CONTINUE
      ITEMPR=IDEMXN
      ITEMPC=IDEMXC
      GOTO1190
C
 1140 CONTINUE
      ITEMPR=IARG(1)
      ITEMPC=IARG(2)
      GOTO1190
C
 1150 CONTINUE
      IF(IHARG(2).EQ.'ROW')GOTO1151
      IF(IHARG(2).EQ.'ROWS')GOTO1151
      IF(IHARG(2).EQ.'LINE')GOTO1151
      IF(IHARG(2).EQ.'OBSE')GOTO1151
      IF(IHARG(2).EQ.'COLU')GOTO1152
      IF(IHARG(2).EQ.'VARI')GOTO1152
      GOTO1151
 1151 CONTINUE
      ITEMPR=IARG(1)
      IF(ITEMPR.LE.1)ITEMPR=1
      ITEMPC=MAXNK/ITEMPR
      GOTO1190
 1152 CONTINUE
      ITEMPC=IARG(1)
      IF(ITEMPC.LE.1)ITEMPC=1
      ITEMPR=MAXNK/ITEMPC
      GOTO1190
C
 1160 CONTINUE
      IF(IHARG(2).EQ.'ROW')GOTO1161
      IF(IHARG(2).EQ.'ROWS')GOTO1161
      IF(IHARG(2).EQ.'LINE')GOTO1161
      IF(IHARG(2).EQ.'OBSE')GOTO1161
      IF(IHARG(2).EQ.'COLU')GOTO1162
      IF(IHARG(2).EQ.'VARI')GOTO1162
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1989
      IF(IHARG(2).EQ.'FACT')GOTO1162
      GOTO1161
 1161 CONTINUE
      ITEMPR=IARG(1)
      ITEMPC=IARG(3)
      GOTO1190
 1162 CONTINUE
      ITEMPC=IARG(1)
      ITEMPR=IARG(3)
      GOTO1190
C
 1190 CONTINUE
      ITEMRC=ITEMPR*ITEMPC
C
C               *************************************
C               **  STEP 12--                      **
C               **  DETERMINE IF THE SPECIFIED     **
C               **  OBSERVATIONS(= ROW) DIMENSION  **
C               **  IS TOO SMALL OR LARGE.         **
C               *************************************
C
      IF(MINR.LE.ITEMPR.AND.ITEMPR.LE.MAXR)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE OBSERVATIONS (= ROW) DIMENSION')
      CALL DPWRST('XXX','BUG ')
      IF(ITEMPR.LT.MINR)
     1WRITE(ICOUT,1213)
 1213 FORMAT('      IS TOO SMALL.')
      IF(ITEMPR.LT.MINR)
     1CALL DPWRST('XXX','BUG ')
      IF(ITEMPR.GT.MAXR)
     1WRITE(ICOUT,1214)
 1214 FORMAT('      IS TOO LARGE.')
      IF(ITEMPR.GT.MAXR)
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINR,MAXR
 1215 FORMAT('      IT MUST BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)ITEMPR
 1216 FORMAT('      THE SPECIFIED VALUE IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *************************************
C               **  STEP 13--                      **
C               **  DETERMINE IF THE SPECIFIED     **
C               **  VARIABLES(= COLUMN) DIMENSION  **
C               **  IS TOO LARGE.                  **
C               *************************************
C
      IF(MINC.LE.ITEMPC.AND.ITEMPC.LE.MAXC)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE VARIABLES (= COLUMN) DIMENSION')
      CALL DPWRST('XXX','BUG ')
      IF(ITEMPC.LT.MINC)
     1WRITE(ICOUT,1313)
 1313 FORMAT('      IS TOO SMALL.')
      IF(ITEMPC.LT.MINC)
     1CALL DPWRST('XXX','BUG ')
      IF(ITEMPC.GT.MAXC)
     1WRITE(ICOUT,1314)
 1314 FORMAT('      IS TOO LARGE.')
      IF(ITEMPC.GT.MAXC)
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)MINC,MAXC
 1315 FORMAT('      IT MUST BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)ITEMPC
 1316 FORMAT('      THE SPECIFIED VALUE IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)
 1317 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
C               *************************************
C               **  STEP 14--                      **
C               **  DETERMINE IF THE COMBINED     **
C               **  DIMENSION (= ROW X COLUMN)    **
C               **  IS TOO LARGE.                  **
C               *************************************
C
      IF(MINRC.LE.ITEMRC.AND.ITEMRC.LE.MAXRC)GOTO1490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      THE JOINT ROW AND COLUMN DIMENSIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ITEMRC.LT.MINRC)
     1WRITE(ICOUT,1413)
 1413 FORMAT('      IS TOO SMALL.')
      IF(ITEMRC.LT.MINRC)
     1CALL DPWRST('XXX','BUG ')
      IF(ITEMRC.GT.MAXRC)
     1WRITE(ICOUT,1414)
 1414 FORMAT('      IS TOO LARGE.')
      IF(ITEMRC.GT.MAXRC)
     1CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      THEIR PRODUCT MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)MINRC,MAXRC
 1416 FORMAT('      BE BETWEEN ',I8,' & ',I8,' (INCLUSIVE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)ITEMRC
 1417 FORMAT('      THEIR PRODUCT IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      NO REDIMENSIONING WAS CARRIED OUT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1490 CONTINUE
C
C               *****************************
C               **  STEP 15--              **
C               **  SET THE DIMENSIONS     **
C               **  TO THE DESIRED VALUES  **
C               *****************************
C
      MAXNOL=MAXN
      MAXN=ITEMPR
      MAXCOL=ITEMPC
      MAXNNE=MAXN
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED JULY 1989
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
C               ********************************
C               **  STEP 16--                 **
C               **  PRINT OUT THE DIMENSIONS  **
C               ********************************
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1613)
 1613 FORMAT('DIMENSION INFORMATION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1614)MAXNK
 1614 FORMAT('          MAXIMUM DATA ARRAY SIZE            = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)MAXN
 1615 FORMAT('          MAXIMUM NUMBER OBS/VARIABLE (ROWS) = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1616)MAXCOL
 1616 FORMAT('          MAXIMUM NUMBER VARIABLES (COLUMNS) = ',I8)
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
C
      IH='MAXR'
      IH2='OWS '
      VALUE0=MAXN
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGS2,IERROR)
C
      IH='MAXC'
      IH2='OLS '
      VALUE0=MAXCOL
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGS2,IERROR)
C
C
C               *************************************
C               **  STEP 13--                      **
C               **  DETERMINE IF ANY OBSERVATIONS  **
C               **  NEED TO BE TRUNCATED           **
C               *************************************
C
      ITRUND='NO'
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   OCTOBER 1991
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'OFF')GOTO2009
CCCCC THE FOLLOWING LINE WAS ADDED   OCTOBER 1991
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2001)
 2001 FORMAT('FROM THE MIDDLE OF DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2002)NUMCOL,NUMNAM,IBUGS2
 2002 FORMAT('NUMCOL,NUMNAM,IBUGS2 = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 2009 CONTINUE
C
      IF(NUMCOL.LE.0)GOTO2190
      DO2100ICOL=1,NUMCOL
      ICOLTG=ICOL
      IF(MAXNNE.GT.MAXNOL)ICOLTG=NUMCOL-ICOL+1
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,999)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2101)MAXNNE,MAXNOL,ICOL,ICOLTG
 2101 FORMAT('MAXNNE,MAXNOL,ICOL,ICOLTG               = ',4I8)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IDONE='NO'
      IF(NUMNAM.LE.0)GOTO2190
      DO2200INAM=1,NUMNAM
      IF(IVALUE(INAM).EQ.ICOLTG.AND.IUSE(INAM).EQ.'V')GOTO2210
      GOTO2200
 2210 CONTINUE
C
      IF(IDONE.EQ.'YES')GOTO2390
      NOLD=IN(INAM)
      IV1OLD=IVSTAR(INAM)
      IV2OLD=IVSTOP(INAM)
C
      IF(NOLD.LE.MAXNNE)NNEW=NOLD
      IF(NOLD.GT.MAXNNE)NNEW=MAXNNE
      IF(NOLD.LE.MAXNNE)GOTO2219
      IF(IFEEDB.EQ.'OFF')GOTO2218
      WRITE(ICOUT,2211)IHNAME(INAM),IHNAM2(INAM),ICOLTG
 2211 FORMAT('    NOTE--VARIABLE ',A4,A4,'  (COLUMN ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)NOLD,MAXNNE
 2212 FORMAT('          TRUNCATED FROM ',I8,' TO ',I8,
     1' OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('          IN THE PROCESS OF  REDIMENSIONING')
      CALL DPWRST('XXX','BUG ')
 2218 CONTINUE
      ITRUND='YES'
 2219 CONTINUE
C
      IV1NEW=MAXNNE*(ICOLTG-1)+1
      IV2NEW=MAXNNE*(ICOLTG-1)+NNEW
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2221)NOLD,MAXNNE,NNEW
 2221 FORMAT('NOLD,MAXNNE,NNEW                        = ',3I8)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2222)IV1OLD,IV2OLD,IV1NEW,IV2NEW
 2222 FORMAT('IV1OLD,IV2OLD,IV1NEW,IV2NEW             = ',4I8)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      J=IV1OLD-1
      IF(IV1NEW.GT.IV1OLD)GOTO2390
      DO2300I=IV1NEW,IV2NEW
      J=J+1
      V(I)=V(J)
 2300 CONTINUE
 2380 CONTINUE
      IDONE='YES'
 2390 CONTINUE
C
      IVSTAR(INAM)=IV1NEW
      IVSTOP(INAM)=IV2NEW
      IN(INAM)=NNEW
      IF(IBUGS2.EQ.'ON')WRITE(ICOUT,2391)INAM,IVSTAR(INAM),IVSTOP(INAM),
     1IN(INAM)
 2391 FORMAT('INAM,IVSTAR(INAM),IVSTOP(INAM),IN(INAM) = ',4I8)
      IF(IBUGS2.EQ.'ON')CALL DPWRST('XXX','BUG ')
 2200 CONTINUE
C
 2100 CONTINUE
 2190 CONTINUE
C
      IF(ITRUND.EQ.'YES')GOTO2199
      IF(IFEEDB.EQ.'OFF')GOTO2199
      WRITE(ICOUT,2191)
 2191 FORMAT('    NOTE--NO DATA TRUNCATION OCCURRED FOR ANY ',
     1'VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2192)
 2192 FORMAT('          (COLUMNS) IN THE PROCESS OF REDIMENSIONING')
      CALL DPWRST('XXX','BUG ')
 2199 CONTINUE
C
C               **********************************
C               **  STEP 14--                   **
C               **  DETERMINE IF ANY VARIABLES  **
C               **  NEED TO BE TRUNCRATED       **
C               **********************************
C
      ITRUNV='NO'
C
      IF(NUMCOL.LE.MAXCOL)GOTO3190
      NUMCOL=MAXCOL
      IDONE='NO'
C
      IF(NUMNAM.LE.0)GOTO3190
      INAM=0
 3100 CONTINUE
      INAM=INAM+1
      IF(INAM.GT.NUMNAM)GOTO3200
      IF(IUSE(INAM).EQ.'V'.AND.IVALUE(INAM).GT.MAXCOL)GOTO3210
      GOTO3200
C
 3210 CONTINUE
      NUMNAM=NUMNAM-1
      ICOLV=IVALUE(INAM)
      IF(IFEEDB.EQ.'OFF')GOTO3219
      WRITE(ICOUT,3211)IHNAME(INAM),IHNAM2(INAM),ICOLV
 3211 FORMAT('    NOTE--VARIABLE ',A4,A4,'  (COLUMN ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3212)
 3212 FORMAT('          DELETED IN THE PROCESS OF  REDIMENSIONING')
      CALL DPWRST('XXX','BUG ')
 3219 CONTINUE
      ITRUNV='YES'
C
      NUMNM1=NUMNAM-1
      IF(INAM.GT.NUMNM1)GOTO3229
      DO3220I=INAM,NUMNM1
      IP1=I+1
      IHNAME(I)=IHNAME(IP1)
      IHNAM2(I)=IHNAM2(IP1)
      IUSE(I)=IUSE(IP1)
      IN(I)=IN(IP1)
      IVSTAR(I)=IVSTAR(IP1)
      IVSTOP(I)=IVSTOP(IP1)
      IVALUE(I)=IVALUE(IP1)
      VALUE(I)=VALUE(IP1)
 3220 CONTINUE
 3229 CONTINUE
      NUMNAM=NUMNAM-1
C
 3200 CONTINUE
C
 3190 CONTINUE
C
      IF(ITRUNV.EQ.'YES')GOTO3199
      IF(IFEEDB.EQ.'OFF')GOTO3199
      WRITE(ICOUT,3191)
 3191 FORMAT('    NOTE--NO VARIABLES WERE DELETED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3192)
 3192 FORMAT('          IN THE PROCESS OF REDIMENSIONING')
      CALL DPWRST('XXX','BUG ')
 3199 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  REDEFINE THE COLUMN DESIGNATION  **
C               **  FOR PRED (PREDICTED VALUE)       **
C               **      RES (RESIDUALS)              **
C               **      YPLOT                        **
C               **      XPLOT                        **
C               **      X2PLOT                       **
C               **      TAGPLOT                      **
C               ***************************************
C
      IF(NUMNAM.LE.0)GOTO4900
C
      DO4100I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'PRED'.AND.IHNAM2(I).EQ.'    ')GOTO4150
 4100 CONTINUE
      GOTO4190
 4150 CONTINUE
      IVALUE(I2)=MAXCOL+1
      VALUE(I2)=IVALUE(I2)
      GOTO4190
 4190 CONTINUE
C
      DO4200I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'RES '.AND.IHNAM2(I).EQ.'    ')GOTO4250
 4200 CONTINUE
      GOTO4290
 4250 CONTINUE
      IVALUE(I2)=MAXCOL+2
      VALUE(I2)=IVALUE(I2)
      GOTO4290
 4290 CONTINUE
C
      DO4300I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'YPLO'.AND.IHNAM2(I).EQ.'T   ')GOTO4350
 4300 CONTINUE
      GOTO4390
 4350 CONTINUE
      IVALUE(I2)=MAXCOL+3
      VALUE(I2)=IVALUE(I2)
      GOTO4390
 4390 CONTINUE
C
      DO4400I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'XPLO'.AND.IHNAM2(I).EQ.'T   ')GOTO4450
 4400 CONTINUE
      GOTO4490
 4450 CONTINUE
      IVALUE(I2)=MAXCOL+4
      VALUE(I2)=IVALUE(I2)
      GOTO4490
 4490 CONTINUE
C
      DO4500I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'X2PL'.AND.IHNAM2(I).EQ.'OT  ')GOTO4550
 4500 CONTINUE
      GOTO4590
 4550 CONTINUE
      IVALUE(I2)=MAXCOL+5
      VALUE(I2)=IVALUE(I2)
      GOTO4590
 4590 CONTINUE
C
      DO4600I=1,NUMNAM
      I2=I
      IF(IHNAME(I).EQ.'TAGP'.AND.IHNAM2(I).EQ.'LOT ')GOTO4650
 4600 CONTINUE
      GOTO4690
 4650 CONTINUE
      IVALUE(I2)=MAXCOL+6
      VALUE(I2)=IVALUE(I2)
      GOTO4690
 4690 CONTINUE
C
 4900 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPDIME--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2
 9012 FORMAT('IBUGS2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMNAM,MAXNAM
 9013 FORMAT('NUMNAM,MAXNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXNK
 9014 FORMAT('MAXNK = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMN,MAXN,MAXNXT
 9015 FORMAT('NUMN,MAXN,MAXNXT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMCOL,MAXCOL
 9016 FORMAT('NUMCOL,MAXCOL = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)MINR,MAXR,MINC,MAXC,MINRC,MAXRC
 9017 FORMAT('MINR,MAXR,MINC,MAXC,MINRC,MAXRC = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ITEMPR,ITEMPC,ITEMRC
 9018 FORMAT('ITEMPR,ITEMPC,ITEMRC = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)
 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),',
     1'IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)')
      CALL DPWRST('XXX','BUG ')
      IF(NUMNAM.LE.0)GOTO9024
      DO9022I=1,NUMNAM
      WRITE(ICOUT,9023)I,IHNAME(I),IHNAM2(I),IUSE(I),IN(I),
     1IVSTAR(I),IVSTOP(I),IVALUE(I),VALUE(I)
 9023 FORMAT(I8,2X,A4,2X,A4,2X,A4,4I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDOT(IFOUND,IERROR)
C
C     PURPOSE--THIS IS A SUBROUTINE FOR THE
C              . COMMAND (A NULL COMMAND).
C              THIS CAPABILITY IS USEFUL FOR PROVIDING A VISUAL
C              SEPARATOR BETWEEN SECTIONS OF STORED DATAPLOT
C              CODE ON MASS STORAGE, OR FOR    COMMENTING OUT
C              A GIVEN LINE OF DATAPLOT CODE.
C     INPUT  ARGUMENTS--NONE
C     OUTPUT ARGUMENTS--IFOUND ('YES' OR 'NO')
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C                     --NOVEMBER  1980.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPDOUB(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PREICSION SWITCH
C              AS DOUBLE PRECISION.
C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
C              CALCULATIONS WILL ALL BE CARRIED OUT
C              IN DOUBLE PRECISION.
C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFPR (A  HOLLERITH VARIABLE)
C                     --IHMXPR (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IPREC  (A HOLLERITH 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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPR
      CHARACTER*4 IHMXPR
      CHARACTER*4 IPREC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1130
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1130
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      GOTO1130
C
 1120 CONTINUE
      IHOLD=IDEFPR
      GOTO1160
C
 1130 CONTINUE
      IHOLD='DOUB'
      GOTO1160
C
 1160 CONTINUE
      IF(IHOLD.EQ.'DOUB'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'TRIP'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'SING')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'DOUB')GOTO1170
      IF(IHOLD.EQ.'QUAD'.AND.IHMXPR.EQ.'TRIP')GOTO1170
      GOTO1180
C
 1170 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('***** ERROR IN DPDOUB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1173)
 1173 FORMAT('      THE DESIRED PRECISION IS HIGHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1174)
 1174 FORMAT('      THAN PERMITTED ON THIS COMPUTER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1175)IHOLD
 1175 FORMAT('      DESIRED PRECISION           = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1176)IHMXPR
 1176 FORMAT('      MAXIMUM ALLOWABLE PRECISION = ',A4)
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1180 CONTINUE
      IPREC=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1188)IPREC
 1188 FORMAT('THE PRECISION SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPDRA2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LINE
C              WITH ONE END OF THE LINE 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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LINE               **
C               *********************************
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y2
C
      NP=2
C
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRA2--')
      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
      SUBROUTINE DPDRAW(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC1UNITSW,
     1X1UNIT,Y1UNIT,X2UNIT,Y2UNIT,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LINES
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE ENDS
C           OF THE LINE SEGMENTS.
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 LINE 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 LINE 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 LINE 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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     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         --SEPTEMBER 1994.  UNITS SWITCH (DATA OR SCREEN)
C     UPDATED         --FEBRUARY  1995.  GENERALIZED DRAW.... COMMAND
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
      CHARACTER*4 ISUBRO
C
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC CHARACTER*4 UNITSW
      CHARACTER*4 X1UNIT
      CHARACTER*4 Y1UNIT
      CHARACTER*4 X2UNIT
      CHARACTER*4 Y2UNIT
C
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRAW')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRAW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,85)X1UNIT,Y1UNIT,X2UNIT,Y2UNIT
   85 FORMAT('X1UNIT,Y1UNIT,X2UNIT,Y2UNIT= ',4A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='LINE'
      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 DPDRAW--')
      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 LINE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH OPPOSITE END 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('      DRAW 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      DRAW 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 SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      IF(X1UNIT.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 SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      IF(Y1UNIT.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 SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(X2UNIT.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 SEPTEMBER 1994
CCCCC AND THEN CHANGED             FEBRUARY  1995
CCCCC IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(Y2UNIT.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPDRA2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRAW')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRAW--')
      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,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 DPDRBA(Y,X,PY,PX,NP,
     1ICASPL,ICAS3D,
     1ISORSW,
     1IBA2SW,ABA2WI,ABA2BA,
     1IBA2BL,IBA2BC,PBA2BT,
     1IBA2FS,IBA2FC,
     1IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT,
     1XDELMN,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1IX1TSC,IY1TSC)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              AND FOR EACH VALUE IN X(.), DRAW A BAR
C              (= VERTICAL OR HORIZONTAL BAR)
C              FROM THE BASE POINT ABA2BA
C              TO THE POINT Y(.).
C              DO SO FOR A SPECIFIED BAR LINE TYPE,
C              LINES COLOR, AND LINE THICKNESS.
C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
C           BACK IN THE MAIN ROUTINE.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87.5
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED--MAY        1987.
C            --JANUARY    1989.  GLOBAL REPLACE ABA2BA WITH ABA2BA (ALAN)
C     UPDATED--FEBRUARY   1989.  GRDRPL TO DPDRPL (ALAN)
C     UPDATED--FEBRUARY   1989.  EXTRA ARGUMENT IN CALL TO DPFIRE (ALAN)
C     UPDATED--FEBRUARY   1989.  BUG WITH PATTERN ON 1ST BAR ONLY (ALAN)
C     UPDATED--FEBRUARY   1989.  NO SORT IF ICASPL='CONT'
C            --FEBRUARY   1989.  RENUMBER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 ISORSW
C
      CHARACTER*4 IBA2SW
      CHARACTER*4 IBA2BL
      CHARACTER*4 IBA2BC
      CHARACTER*4 IBA2FS
      CHARACTER*4 IBA2FC
      CHARACTER*4 IBA2PT
      CHARACTER*4 IBA2PL
      CHARACTER*4 IBA2PC
      CHARACTER*4 IBA2TY
      CHARACTER*4 IBA2DI
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IY1TSC
C
      CHARACTER*4 ITYPE
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 IDIR
C
CCCCC CHARACTER*4 IHORPA
CCCCC CHARACTER*4 IVERPA
CCCCC CHARACTER*4 IDUPPA
CCCCC CHARACTER*4 IDDOPA
C
      CHARACTER*4 IFIGSV
      CHARACTER*4 IFLAG
      CHARACTER*4 IPATT2
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION PY(*)
      DIMENSION PX(*)
C
      DIMENSION PY2(20)
      DIMENSION PX2(20)
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
      HOLD=1.0
      ABASE=0.0
      PBASE=0.0
      PBASE2=0.0
      PLEFT=0.0
      PRIGHT=0.0
      AWIDTH=0.0
      PWIDTH=0.0
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      FYMIN=FY1MIN
      FYMAX=FY1MAX
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NP
   52 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)XDELMN
   54 FORMAT('XDELMN = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO69
      DO65I=1,3
      WRITE(ICOUT,66)I,X(I),Y(I)
   66 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      NPM2=NP-2
      DO67I=NPM2,NP
      WRITE(ICOUT,68)I,X(I),Y(I)
   68 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   67 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,70)ISORSW
   70 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IBA2SW,ABA2WI,ABA2BA
   71 FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IBA2BL,IBA2BC,PBA2BT
   72 FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IBA2FS,IBA2FC
   73 FORMAT('IBA2FS,IBA2FC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
   74 FORMAT('IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IX1TSC,IY1TSC
   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************************
C               **  STEP 11--                                  **
C               **  IF CALLED FOR, SORT THE DATA               **
C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
C               *************************************************
C
      IDIR=IBA2DI
C
      IF(ISORSW.EQ.'OFF')GOTO1150
      IF(ICASPL.EQ.'PIEC')GOTO1150
      IF(ICAS3D.EQ.'ON')GOTO1150
      IF(ICASPL.EQ.'CONT')GOTO1150
C
      CALL SORTC2(X,Y,NP,PX,PY)
      GOTO1190
C
 1150 CONTINUE
      DO1160I=1,NP
      PX(I)=X(I)
      PY(I)=Y(I)
 1160 CONTINUE
      GOTO1190
C
 1190 CONTINUE
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO1199
      WRITE(ICOUT,1194)IPR
 1194 FORMAT('IPR=',I4)
      CALL DPWRST('XXX','BUG ')
      DO1192I=1,10
      WRITE(ICOUT,1196) I,PX(I),PY(I)
 1196 FORMAT('I,PX(I),PY(I)=',I4,2X,E15.7,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 1192 CONTINUE
 1199 CONTINUE
C
C               ************************************************
C               **  STEP 12--                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
C               ************************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO1210
      GOTO1290
C
 1210 CONTINUE
      IF(IDIR.EQ.'H')GOTO1215
      GOTO1219
 1215 CONTINUE
      IF(ABA2BA.LE.0.0)HOLD=ABA2BA
      IF(ABA2BA.LE.0.0)GOTO1250
 1219 CONTINUE
C
      IF(ISORSW.EQ.'ON')GOTO1220
      GOTO1230
C
 1220 CONTINUE
      J=1
      IF(PX(J).LE.0.0)GOTO1250
      GOTO1290
C
 1230 CONTINUE
      DO1235I=1,NP
      J=I
      IF(PX(J).LE.0.0)GOTO1250
 1235 CONTINUE
      GOTO1290
C
 1250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1251)
 1251 FORMAT('***** ERROR IN DPDRBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1252)
 1252 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1253)
 1253 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1254)
 1254 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1255)
 1255 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1256)PX(J)
 1256 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1257)
 1257 FORMAT('      THIS VALUE CAME FROM THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1258)
 1258 FORMAT('      HORIZONTAL AXIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1259)
 1259 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1260)
 1260 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
 1290 CONTINUE
C
      IF(IY1TSC.EQ.'LOG')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      IF(IDIR.EQ.'V')GOTO1315
      GOTO1319
 1315 CONTINUE
      IF(ABA2BA.LE.0.0)HOLD=ABA2BA
      IF(ABA2BA.LE.0.0)GOTO1350
 1319 CONTINUE
C
      IF(ISORSW.EQ.'ON')GOTO1320
      GOTO1330
C
 1320 CONTINUE
      J=1
      IF(PY(J).LE.0.0)HOLD=PY(J)
      IF(PY(J).LE.0.0)GOTO1350
      GOTO1390
C
 1330 CONTINUE
      DO1335I=1,NP
      J=I
      IF(PY(J).LE.0.0)HOLD=PY(J)
      IF(PY(J).LE.0.0)GOTO1350
 1335 CONTINUE
      GOTO1390
C
 1350 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1351)
 1351 FORMAT('***** ERROR IN DPDRBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1352)
 1352 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1353)
 1353 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1354)
 1354 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1355)
 1355 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1356)HOLD
 1356 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1357)
 1357 FORMAT('      THIS VALUE CAME FROM THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1358)
 1358 FORMAT('      VERTICAL AXIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1359)
 1359 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1360)
 1360 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
 1390 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO1399
      WRITE(ICOUT,1391) 
 1391 FORMAT('AT BRANCH POINT 1390')
      CALL DPWRST('XXX','BUG ')
 1399 CONTINUE
C
C               ******************************************
C               **  STEP 40--                           **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      ABASE=ABA2BA
      AWIDTH=ABA2WI
C
      IF(IDIR.EQ.'V')GOTO4001
      GOTO4002
 4001 CONTINUE
      IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.LE.0.0)AWIDTH=1.0
      IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.GT.0.0)AWIDTH=XDELMN
 4002 CONTINUE
C
      IF(IDIR.EQ.'H')GOTO4003
      GOTO4004
 4003 CONTINUE
CCCCC IF(AWIDTH.EQ.CPUMIN.AND.YDELMN.LE.0.0)AWIDTH=1.0
CCCCC IF(AWIDTH.EQ.CPUMIN.AND.YDELMN.GT.0.0)AWIDTH=XDELMN
      IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.LE.0.0)AWIDTH=1.0
      IF(AWIDTH.EQ.CPUMIN.AND.XDELMN.GT.0.0)AWIDTH=XDELMN
 4004 CONTINUE
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO4009
      WRITE(ICOUT,4008) ABASE,AWIDTH
 4008 FORMAT('ABASE,AWIDTH=',E15.7,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
 4009 CONTINUE
C
      IF(IX1TSC.EQ.'LOG')GOTO4010
      GOTO4019
 4010 CONTINUE
      IF(IDIR.EQ.'H')ABASE=ALOG10(ABASE)
      DO4015I=1,NP
      PX(I)=ALOG10(PX(I))
 4015 CONTINUE
 4019 CONTINUE
C
      IF(IY1TSC.EQ.'LOG')GOTO4020
      GOTO4029
 4020 CONTINUE
      IF(IDIR.EQ.'V')ABASE=ALOG10(ABASE)
      DO4025I=1,NP
      PY(I)=ALOG10(PY(I))
 4025 CONTINUE
 4029 CONTINUE
C
C               *****************************************************
C               **  STEP 50--                                      **
C               **  TRANSLATE THE DATA POINTS                      **
C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
C               *****************************************************
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO5001
      WRITE(ICOUT,4999)
 4999 FORMAT( 'AT 5001 BREAKPOINT')
      CALL DPWRST('XXX','BUG ')
 5001 CONTINUE
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      IF(IX1TSC.EQ.'LOG')FXMIN=ALOG10(FX1MIN)
      IF(IX1TSC.EQ.'LOG')FXMAX=ALOG10(FX1MAX)
C
      FYMIN=FY1MIN
      FYMAX=FY1MAX
      IF(IY1TSC.EQ.'LOG')FYMIN=ALOG10(FY1MIN)
      IF(IY1TSC.EQ.'LOG')FYMAX=ALOG10(FY1MAX)
C
      FXRANG=FXMAX-FXMIN
      FYRANG=FYMAX-FYMIN
      PXRANG=PXMAX-PXMIN
      PYRANG=PYMAX-PYMIN
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO5002
      WRITE(ICOUT,4993) FXMIN,FXMAX,FYMIN,FYMAX
 4993 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX=',4(E15.7,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4994) FXRANG,FYRANG,PXRANG,PYRANG
 4994 FORMAT('FXRANG,FYRANG,PXRANG,PYRANG=',6(E15.7,1X))
      CALL DPWRST('XXX','BUG ')
 5002 CONTINUE
C
      DO5000I=1,NP
      FXRATI=(PX(I)-FXMIN)/FXRANG
      FYRATI=(PY(I)-FYMIN)/FYRANG
      PX(I)=PXMIN+FXRATI*PXRANG
      PY(I)=PYMIN+FYRATI*PYRANG
 5000 CONTINUE
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO5003
      DO5004I=1,NP
      WRITE(ICOUT,5006) PX(I),PY(I)
 5006 FORMAT('PX(I),PY(I)=',2(E15.7,1X))
      CALL DPWRST('XXX','BUG ')
 5004 CONTINUE
 5003 CONTINUE
C
      IF(IDIR.EQ.'V')GOTO5010
      GOTO5019
 5010 CONTINUE
      FYRATI=(ABASE-FYMIN)/FYRANG
      PBASE=PYMIN+FYRATI*PYRANG
      PWIDTH=AWIDTH*(PXRANG/FXRANG)
 5019 CONTINUE
C
      IF(IDIR.EQ.'H')GOTO5020
      GOTO5029
 5020 CONTINUE
      FXRATI=(ABASE-FXMIN)/FXRANG
      PBASE=PXMIN+FXRATI*PXRANG
      PWIDTH=AWIDTH*(PYRANG/FYRANG)
 5029 CONTINUE
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO5039
      WRITE(ICOUT,5038) FXRATI,PBASE,PWIDTH
 5038 FORMAT('FXRATI,PBASE,PWIDTH=',3(E15.7,1X))
      CALL DPWRST('XXX','BUG ')
 5039 CONTINUE
C
C               *******************************
C               **  STEP 70--                **
C               **  PREPARE TO MAKE VARIOUS  **
C               **  LINE SETTINGS            **
C               *******************************
C
      ITYPE='LINE'
C
C               **********************************************
C               **  STEP 71--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
CCCCC IPATT=IBA2BL
CCCCC CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 72--                **
C               **  SET THE LINE PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 73--                               **
C               **  TRANSLATE THE  DESIRED                  **
C               **  LINE THICKNESS                          **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
CCCCC PTHICK=PBA2BT
CCCCC CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 74--                **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               **********************************************
C               **  STEP 75--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
CCCCC ICOL=IBA2BC
CCCCC CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 76--                **
C               **  SET THE LINE COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSECO(ITYPE,ICOL,JCOL)
C
C               **************************************
C               **  STEP 80--                       **
C               **  DRAW AND FILL BARS              **
C               **  (BUT CLIP FIRST, IF NECESSARY)  **
C               **************************************
C
CCCCC IFIG='GENE'
      IFIG='BOX'
      IF(IBA2TY.EQ.'3')IFIG='CUBE'
      IFIGSV=IFIG
      PBASE2=PBASE
C
      CALL DPSQUE(PX,PY,NP,
     1PXMIN,PXMAX,PYMIN,PYMAX)
C
C               ***************************************
C               **  STEP 81--                        **
C               **  DRAW OUT ALL VERTICAL BARS       **
C               **  (BUT FILL FIRST, IF CALLED FOR)  **
C               ***************************************
C
      IF(IDIR.EQ.'V')GOTO8100
      GOTO8190
C
 8100 CONTINUE
C  SEPTEMBER, 1987 - MOVE SETTINGS INSIDE THE LOOP
CCCCC IPATT=IBA2PT
CCCCC PTHICK=PBA2PT
CCCCC PXGAP=PBA2PS
CCCCC PYGAP=PBA2PS
CCCCC ICOLF=IBA2FC
CCCCC ICOLP=IBA2PC
C
      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
C
      DO8105I=1,NP
C
      IPATT=IBA2PT
      IPATT2=IBA2PL
      PTHICK=PBA2PT
      PXGAP=PBA2PS
      PYGAP=PBA2PS
      ICOLF=IBA2FC
      ICOLP=IBA2PC
C
      PLEFT=PX(I)-PWIDTH/2.0
      PRIGHT=PX(I)+PWIDTH/2.0
      IF(PLEFT.LT.PXMIN.AND.(PXMIN-PLEFT).LE.0.0001)PLEFT=PXMIN
      IF(PRIGHT.GT.PXMAX.AND.(PRIGHT-PXMAX).LE.0.0001)PRIGHT=PXMAX
C
      IF(PRIGHT.LT.PXMIN)GOTO8105
      IF(PLEFT.GT.PXMAX)GOTO8105
      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO8105
      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO8105
C
      X1=PLEFT
      Y1=PBASE2
      X2=PRIGHT
      Y2=PY(I)
C
      DELX=ABS(X2-X1)
      DELY=ABS(Y2-Y1)
      DELMIN=DELX
CCCCC IF(DELY.LT.DELX)DELMIN=DELY
      P3D=0.3
      DEL3D=P3D*DELMIN
C
      IF(IBA2FS.EQ.'OFF')GOTO8150
C
      IF(IBA2FS.EQ.'ON')GOTO8110
      IF(IBA2FS.EQ.'ONF')GOTO8110
      IF(IBA2FS.EQ.'ONS')GOTO8120
      IF(IBA2FS.EQ.'ONT')GOTO8130
      IF(IBA2FS.EQ.'ONFS')GOTO8110
      IF(IBA2FS.EQ.'ONSF')GOTO8110
      IF(IBA2FS.EQ.'ONFT')GOTO8110
      IF(IBA2FS.EQ.'ONTF')GOTO8110
      IF(IBA2FS.EQ.'ONST')GOTO8120
      IF(IBA2FS.EQ.'ONTS')GOTO8120
C
C     FRONT FACE
C
 8110 CONTINUE
      PX2(1)=X1
      PY2(1)=Y1
C
      PX2(2)=X2
      PY2(2)=Y1
C
      PX2(3)=X2
      PY2(3)=Y2
C
      PX2(4)=X1
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y1
C
      NP2=5
C
      DO8115J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8115 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
      IF(IBA2TY.EQ.'2')GOTO8150
C
      IF(IBA2FS.EQ.'ON')GOTO8120
      IF(IBA2FS.EQ.'ONF')GOTO8150
      IF(IBA2FS.EQ.'ONS')GOTO8120
      IF(IBA2FS.EQ.'ONT')GOTO8130
      IF(IBA2FS.EQ.'ONFS')GOTO8120
      IF(IBA2FS.EQ.'ONSF')GOTO8120
      IF(IBA2FS.EQ.'ONFT')GOTO8130
      IF(IBA2FS.EQ.'ONTF')GOTO8130
      IF(IBA2FS.EQ.'ONST')GOTO8120
      IF(IBA2FS.EQ.'ONTS')GOTO8120
C
C     SIDE (= RIGHT) FACE
C
 8120 CONTINUE
      IF(IBA2TY.EQ.'2')GOTO8150
      PX2(1)=X2
      PY2(1)=Y2
C
      PX2(2)=X2+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y1+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y1
C
      PX2(5)=X2
      PY2(5)=Y2
C
      NP2=5
C
      DO8125J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8125 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
      IF(IBA2FS.EQ.'ON')GOTO8130
      IF(IBA2FS.EQ.'ONF')GOTO8150
      IF(IBA2FS.EQ.'ONS')GOTO8150
      IF(IBA2FS.EQ.'ONT')GOTO8130
      IF(IBA2FS.EQ.'ONFS')GOTO8150
      IF(IBA2FS.EQ.'ONSF')GOTO8150
      IF(IBA2FS.EQ.'ONFT')GOTO8130
      IF(IBA2FS.EQ.'ONTF')GOTO8130
      IF(IBA2FS.EQ.'ONST')GOTO8130
      IF(IBA2FS.EQ.'ONTS')GOTO8130
C
C     TOP FACE
C
 8130 CONTINUE
      IF(IBA2TY.EQ.'2')GOTO8150
      PX2(1)=X1
      PY2(1)=Y2
C
      PX2(2)=X1+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y2+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y2
C
      NP2=5
C
      DO8135J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8135 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PX2GAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
 8150 CONTINUE
C
C     DRAW OUT THE EDGES OF THE BAR
C
      IPATT=IBA2BL
      PTHICK=PBA2BT
      ICOL=IBA2BC
C
      PX2(1)=X1
      PY2(1)=Y1
C
      PX2(2)=X2
      PY2(2)=Y1
C
      PX2(3)=X2
      PY2(3)=Y2
C
      PX2(4)=X1
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y1
C
      NP2=5
C
      DO8151J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8151 CONTINUE
      IFLAG='ON'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      IF(IBA2TY.EQ.'2')GOTO8105
C
      PX2(1)=X1
      PY2(1)=Y2
C
      PX2(2)=X1+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y2+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y2
C
      NP2=4
C
      DO8152J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8152 CONTINUE
      IFLAG='OFF'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      PX2(1)=X2+DEL3D
      PY2(1)=Y2+DEL3D
C
      PX2(2)=X2+DEL3D
      PY2(2)=Y1+DEL3D
C
      PX2(3)=X2
      PY2(3)=Y1
C
      NP2=3
C
      DO8153J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8153 CONTINUE
      IFLAG='OFF'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
 8105 CONTINUE
C
 8190 CONTINUE
C
C               ***************************************
C               **  STEP 82--                        **
C               **  DRAW OUT ALL HORIZONTAL BARS     **
C               **  (BUT FILL FIRST, IF CALLED FOR)  **
C               ***************************************
C
      IF(IDIR.EQ.'H')GOTO8200
      GOTO8290
C
 8200 CONTINUE
C SEPTEMBER, 1987: MOVE INSIDE LOOP
CCCCC IPATT=IBA2PT
CCCCC PTHICK=PBA2PT
CCCCC PXGAP=PBA2PS
CCCCC PYGAP=PBA2PS
CCCCC ICOLF=IBA2FC
CCCCC ICOLP=IBA2PC
C
      IF(PBASE2.LT.PXMIN.AND.(PXMIN-PBASE2).LE.0.0001)PBASE2=PXMIN
      IF(PBASE2.GT.PXMAX.AND.(PBASE2-PXMAX).LE.0.0001)PBASE2=PXMAX
C
      DO8205I=1,NP
C
      IPATT=IBA2PT
      IPATT2=IBA2PL
      PTHICK=PBA2PT
      PXGAP=PBA2PS
      PYGAP=PBA2PS
      ICOLF=IBA2FC
      ICOLP=IBA2PC
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO8201
      WRITE(ICOUT,8203) 
 8203 FORMAT('IN 8200 LOOP')
      CALL DPWRST('XXX','BUG ')
 8201 CONTINUE
      PBOT=PY(I)-PWIDTH/2.0
      PTOP=PY(I)+PWIDTH/2.0
      IF(PBOT.LT.PYMIN.AND.(PYMIN-PBOT).LE.0.0001)PBOT=PYMIN
      IF(PTOP.GT.PYMAX.AND.(PTOP-PYMAX).LE.0.0001)PTOP=PYMAX
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO8202
      WRITE(ICOUT,8204) PBOT,PTOP
 8204 FORMAT('PBOT,PTOP=',2(E15.7,1X))
      CALL DPWRST('XXX','BUG ')
 8202 CONTINUE
C
      IF(PTOP.LT.PYMIN)GOTO8205
      IF(PBOT.GT.PYMAX)GOTO8205
      IF(PX(I).LT.PXMIN.AND.PBASE2.LT.PXMIN)GOTO8205
      IF(PX(I).GT.PXMAX.AND.PBASE2.GT.PXMAX)GOTO8205
C
      X1=PBASE2
      Y1=PBOT
      X2=PX(I)
      Y2=PTOP
C
      DELX=ABS(X2-X1)
      DELY=ABS(Y2-Y1)
      DELMIN=DELY
CCCCC IF(DELX.LT.DELY)DELMIN=DELX
      P3D=0.3
      DEL3D=P3D*DELMIN
C
      IF(IBA2FS.EQ.'OFF')GOTO8250
C
      IF(IBA2FS.EQ.'ON')GOTO8210
      IF(IBA2FS.EQ.'ONF')GOTO8210
      IF(IBA2FS.EQ.'ONS')GOTO8220
      IF(IBA2FS.EQ.'ONT')GOTO8230
      IF(IBA2FS.EQ.'ONFS')GOTO8210
      IF(IBA2FS.EQ.'ONSF')GOTO8210
      IF(IBA2FS.EQ.'ONFT')GOTO8210
      IF(IBA2FS.EQ.'ONTF')GOTO8210
      IF(IBA2FS.EQ.'ONST')GOTO8220
      IF(IBA2FS.EQ.'ONTS')GOTO8220
C
C     FRONT FACE
C
 8210 CONTINUE
      PX2(1)=X1
      PY2(1)=Y1
C
      PX2(2)=X2
      PY2(2)=Y1
C
      PX2(3)=X2
      PY2(3)=Y2
C
      PX2(4)=X1
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y1
C
      NP2=5
C
      DO8215J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8215 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
      IF(IBA2TY.EQ.'2')GOTO8250
C
      IF(IBA2FS.EQ.'ON')GOTO8220
      IF(IBA2FS.EQ.'ONF')GOTO8250
      IF(IBA2FS.EQ.'ONS')GOTO8220
      IF(IBA2FS.EQ.'ONT')GOTO8230
      IF(IBA2FS.EQ.'ONFS')GOTO8220
      IF(IBA2FS.EQ.'ONSF')GOTO8220
      IF(IBA2FS.EQ.'ONFT')GOTO8230
      IF(IBA2FS.EQ.'ONTF')GOTO8230
      IF(IBA2FS.EQ.'ONST')GOTO8220
      IF(IBA2FS.EQ.'ONTS')GOTO8220
C
C     SIDE (= RIGHT) FACE
C
 8220 CONTINUE
      IF(IBA2TY.EQ.'2')GOTO8250
      PX2(1)=X2
      PY2(1)=Y2
C
      PX2(2)=X2+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y1+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y1
C
      PX2(5)=X2
      PY2(5)=Y2
C
      NP2=5
C
      DO8225J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8225 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
      IF(IBA2FS.EQ.'ON')GOTO8230
      IF(IBA2FS.EQ.'ONF')GOTO8250
      IF(IBA2FS.EQ.'ONS')GOTO8250
      IF(IBA2FS.EQ.'ONT')GOTO8230
      IF(IBA2FS.EQ.'ONFS')GOTO8250
      IF(IBA2FS.EQ.'ONSF')GOTO8250
      IF(IBA2FS.EQ.'ONFT')GOTO8230
      IF(IBA2FS.EQ.'ONTF')GOTO8230
      IF(IBA2FS.EQ.'ONST')GOTO8230
      IF(IBA2FS.EQ.'ONTS')GOTO8230
C
C     TOP FACE
C
 8230 CONTINUE
      IF(IBA2TY.EQ.'2')GOTO8250
      PX2(1)=X1
      PY2(1)=Y2
C
      PX2(2)=X1+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y2+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y2
C
      NP2=5
C
      DO8235J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8235 CONTINUE
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PX2GAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
C
 8250 CONTINUE
C
C     DRAW OUT THE EDGES OF THE BAR
C
      IPATT=IBA2BL
      PTHICK=PBA2BT
      ICOL=IBA2BC
C
      PX2(1)=X1
      PY2(1)=Y1
C
      PX2(2)=X2
      PY2(2)=Y1
C
      PX2(3)=X2
      PY2(3)=Y2
C
      PX2(4)=X1
      PY2(4)=Y2
C
      PX2(5)=X1
      PY2(5)=Y1
C
      NP2=5
C
      DO8251J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8251 CONTINUE
      IFLAG='ON'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      IF(IBA2TY.EQ.'2')GOTO8205
C
      PX2(1)=X1
      PY2(1)=Y2
C
      PX2(2)=X1+DEL3D
      PY2(2)=Y2+DEL3D
C
      PX2(3)=X2+DEL3D
      PY2(3)=Y2+DEL3D
C
      PX2(4)=X2
      PY2(4)=Y2
C
      NP2=4
C
      DO8252J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8252 CONTINUE
      IFLAG='OFF'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
      PX2(1)=X2+DEL3D
      PY2(1)=Y2+DEL3D
C
      PX2(2)=X2+DEL3D
      PY2(2)=Y1+DEL3D
C
      PX2(3)=X2
      PY2(3)=Y1
C
      NP2=3
C
      DO8253J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 8253 CONTINUE
      IFLAG='OFF'
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
 8205 CONTINUE
C
 8290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRBA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NP
 9012 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT
 9014 FORMAT('ABASE,HOLD,PBASE,PBASE2,PLEFT,PRIGHT = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)XDELMN,AWIDTH,PWIDTH
 9015 FORMAT('XDELMN,AWIDTH,PWIDTH = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO9029
      DO9025I=1,3
      WRITE(ICOUT,9026)I,X(I),Y(I)
 9026 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      NPM2=NP-2
      DO9027I=NPM2,NP
      WRITE(ICOUT,9028)I,X(I),Y(I)
 9028 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9027 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9030)ISORSW
 9030 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)IBA2SW,ABA2WI,ABA2BA
 9031 FORMAT('IBA2SW,ABA2WI,ABA2BA = ',A4,2X,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)IBA2BL,IBA2BC,PBA2BT
 9032 FORMAT('IBA2BL,IBA2BC,PBA2BT = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IBA2FS,IBA2FC
 9033 FORMAT('IBA2FS,IBA2FC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT
 9034 FORMAT('IBA2PT,IBA2PL,IBA2PC,IBA2TY,IBA2DI,PBA2PS,PBA2PT = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)IX1TSC,IY1TSC
 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IFIG
 9051 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IPATT,JPATT
 9052 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
 9053 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)ICOL,JCOL,IDIR
 9054 FORMAT('ICOL,JCOL,IDIR = ',A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)ITYPE
 9055 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
 9069 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRCH(Y,X,PY,PX,NP,PY2,PX2,NP2,X3D,
     1ICASPL,ICAS3D,
     1ISORSW,
CCCCC THE FOLLOWING ARGUMENT WAS ADDED MAY 1992 (JJF)
     1ARE2BA,
     1ICH2PA,ICH2FO,ICH2CA,ICH2JU,ICH2DI,ACH2AN,ICH2FI,ICH2CO,
     1PCH2HE,PCH2WI,PCH2TH,PCH2HO,PCH2VO,
     1ITEXSP,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1IX1TSC,IY1TSC,
     1IMPSW2,AMPSCH,AMPSCW)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              DRAW A CHARACTER TRACE OF Y(.) VERSUS X(.),
C              THAT IS, DRAW A SPECIFIED MARKER (= CHARACTER) TYPE
C              AT EACH OF THE PLOT POINTS.
C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
C           BACK IN THE MAIN ROUTINE.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --DECEMBER  1987.  INDEPENDENT CONTROL OF CHAR WIDTH.
C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
C     UPDATED         --SEPTEMBER 1988.  RENUMBER
C     UPDATED         --SEPTEMBER 1988.  IBUGG4 FOR IBUGPL
C     UPDATED         --JUNE      1990.  NORMAL PLOT
C     UPDATED         --MAY       1992.  ADD ARE2BA AS INPUT ARGUMENT
C     UPDATED         --DECEMBER  1996.  SIMPLIFY NORMAL PLOT
C     UPDATED         --SEPTEMBER 1999.  ARGUMENT LIST TO DPCLCH
C     UPDATED         --JANUARY   2000.  ADD X3D TO ARGUEMNT LIST
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 ISORSW
C
      CHARACTER*4 ICH2PA
      CHARACTER*4 ICH2FO
      CHARACTER*4 ICH2CA
      CHARACTER*4 ICH2JU
      CHARACTER*4 ICH2DI
      CHARACTER*4 ICH2FI
      CHARACTER*4 ICH2CO
C
      CHARACTER*4 ITEXSP
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IY1TSC
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 ICASAX
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION X3D(*)
      DIMENSION PY(*)
      DIMENSION PX(*)
      DIMENSION PY2(*)
      DIMENSION PX2(*)
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
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      FYMIN=FY1MIN
      FYMAX=FY1MAX
C
      AHUNDR=100.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRCH')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRCH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NP
   52 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO69
      DO65I=1,3
      WRITE(ICOUT,66)I,X(I),Y(I)
   66 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      NPM2=NP-2
      DO67I=NPM2,NP
      WRITE(ICOUT,68)I,X(I),Y(I)
   68 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   67 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,70)ISORSW
   70 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992 (JJF)
      WRITE(ICOUT,71)ARE2BA
   71 FORMAT('ARE2BA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ICH2PA
   74 FORMAT('ICH2PA= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ICH2FO
   75 FORMAT('ICH2FO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ICH2JU
   76 FORMAT('ICH2JU= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ICH2DI
   77 FORMAT('ICH2DI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)ACH2AN
   78 FORMAT('ACH2AN= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)ICH2FI
   79 FORMAT('ICH2FI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)ICH2CO
   80 FORMAT('ICH2CO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)PCH2HE
   81 FORMAT('PCH2HE= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)PCH2WI
   82 FORMAT('PCH2WI= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)PCH2TH,PCH2VO,PCH2HO
   83 FORMAT('PCH2TH,PCH2VO,PCH2HO= ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)ITEXSP
   84 FORMAT('ITEXSP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)PXMIN,PXMAX,PYMIN,PYMAX
   85 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)FX1MIN,FX1MAX,FY1MIN,FY1MAX
   86 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IX1TSC,IY1TSC
   87 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************************
C               **  STEP 10--                                  **
C               **  IF CALLED FOR, SORT THE DATA               **
C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
C               *************************************************
C
      IF(ISORSW.EQ.'OFF')GOTO1150
      IF(ICASPL.EQ.'PIEC')GOTO1150
      IF(ICAS3D.EQ.'ON')GOTO1150
C
      CALL SORTC2(X,Y,NP,PX,PY)
      GOTO1190
C
 1150 CONTINUE
      DO1160I=1,NP
      PX(I)=X(I)
      PY(I)=Y(I)
 1160 CONTINUE
      GOTO1190
C
 1190 CONTINUE
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS            **
C               **  ARE IN VALID RANGE.                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
C               **  CHECK THAT ALL   HORIZ.  AXIS DATA POINTS ARE > 0.  **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
C               **  OR IF A NORMAL SCALE PLOT IS CALLED FOR,  (JUNE 1990)
C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE        **
C               **  STRICTLY > 0 AND STRICTLY < 100                     **
C               **********************************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO2110
      GOTO2119
 2110 CONTINUE
      ICASAX='2DHO'
      CALL CKLOSC(PX,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2119 CONTINUE
C
      IF(IX1TSC.EQ.'WEIB')GOTO2120
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990
      IF(IX1TSC.EQ.'NORM')GOTO2120
      GOTO2129
 2120 CONTINUE
      ICASAX='2DHO'
      CALL CKPRSC(PX,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2129 CONTINUE
C
C               **********************************************************
C               **  STEP 22--                                           **
C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS            **
C               **  ARE IN VALID RANGE.                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
C               **  CHECK THAT ALL   VERT.   AXIS DATA POINTS ARE > 0.  **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
C               **  OR IF A NORMAL SCALE PLOT IS CALLED FOR,  (JUNE 1990)
C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS ARE        **
C               **  STRICTLY > 0 AND STRICTLY < 100                     **
C               **********************************************************
C
      IF(IY1TSC.EQ.'LOG')GOTO2210
      GOTO2219
 2210 CONTINUE
      ICASAX='2DVE'
      CALL CKLOSC(PY,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2219 CONTINUE
C
      IF(IY1TSC.EQ.'WEIB')GOTO2220
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990
      IF(IY1TSC.EQ.'NORM')GOTO2220
      GOTO2229
 2220 CONTINUE
      ICASAX='2DVE'
      CALL CKPRSC(PY,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2229 CONTINUE
C
C               ******************************************
C               **  STEP 41--                           **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO4110
      GOTO4119
 4110 CONTINUE
      DO4115I=1,NP
      PX(I)=ALOG10(PX(I))
 4115 CONTINUE
 4119 CONTINUE
C
      IF(IY1TSC.EQ.'LOG')GOTO4120
      GOTO4129
 4120 CONTINUE
      DO4125I=1,NP
      PY(I)=ALOG10(PY(I))
 4125 CONTINUE
 4129 CONTINUE
C
C               ******************************************
C               **  STEP 42--                           **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'WEIB')GOTO4210
      GOTO4219
 4210 CONTINUE
      DO4215I=1,NP
      PX(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PX(I))))
 4215 CONTINUE
 4219 CONTINUE
C
      IF(IY1TSC.EQ.'WEIB')GOTO4220
      GOTO4229
 4220 CONTINUE
      DO4225I=1,NP
      PY(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PY(I))))
 4225 CONTINUE
 4229 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1990
C               ******************************************
C               **  STEP 43--                           **
C               **  IF A NORMAL SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'NORM')GOTO4310
      GOTO4340
 4310 CONTINUE
      DO4315I=1,NP
CCCCC PX(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PX(I))))
      ARG=PX(I)/AHUNDR
      CALL NORPPF(ARG,PX(I))
 4315 CONTINUE
 4340 CONTINUE
C
      ABASE=ARE2BA
      IF(IY1TSC.EQ.'NORM')GOTO4360
      GOTO4390
 4360 CONTINUE
CCCCC IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
CCCCC1ABASE2=ALOG(ALOG(AHUNDR/(AHUNDR-ABASE)))
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
     1ARG=ABASE/AHUNDR
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
     1CALL NORPPF(ARG,ABASE2)
      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
      IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
      ABASE=ABASE2
      DO4365I=1,NP
CCCCC PY(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PY(I))))
      ARG=PY(I)/AHUNDR
      CALL NORPPF(ARG,PY(I))
 4365 CONTINUE
 4390 CONTINUE
C
C               *****************************************************
C               **  STEP 50--                                      **
C               **  TRANSLATE THE DATA POINTS                      **
C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
C               *****************************************************
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      IF(IX1TSC.EQ.'LOG')FXMIN=ALOG10(FX1MIN)
      IF(IX1TSC.EQ.'LOG')FXMAX=ALOG10(FX1MAX)
      IF(IX1TSC.EQ.'WEIB')FXMIN=ALOG(ALOG(AHUNDR/(AHUNDR-FX1MIN)))
      IF(IX1TSC.EQ.'WEIB')FXMAX=ALOG(ALOG(AHUNDR/(AHUNDR-FX1MAX)))
CCCCC THE FOLLOWING SECTION WAS SIMPLIFIED   DECEMBER 1996
      IF(IX1TSC.EQ.'NORM')THEN
         ARG=FX1MIN/AHUNDR
         CALL NORPPF(ARG,FXMIN)
         ARG=FX1MAX/AHUNDR
         CALL NORPPF(ARG,FXMAX)
      ENDIF
C
      FYMIN=FY1MIN
      FYMAX=FY1MAX
      IF(IY1TSC.EQ.'LOG')FYMIN=ALOG10(FY1MIN)
      IF(IY1TSC.EQ.'LOG')FYMAX=ALOG10(FY1MAX)
      IF(IY1TSC.EQ.'WEIB')FYMIN=ALOG(ALOG(AHUNDR/(AHUNDR-FY1MIN)))
      IF(IY1TSC.EQ.'WEIB')FYMAX=ALOG(ALOG(AHUNDR/(AHUNDR-FY1MAX)))
CCCCC THE FOLLOWING SECTION WAS SIMPLIFIED   DECEMBER 1996
      IF(IY1TSC.EQ.'NORM')THEN
         ARG=FY1MIN/AHUNDR
         CALL NORPPF(ARG,FYMIN)
         ARG=FY1MAX/AHUNDR
         CALL NORPPF(ARG,FYMAX)
      ENDIF
C
      FXRANG=FXMAX-FXMIN
      FYRANG=FYMAX-FYMIN
      PXRANG=PXMAX-PXMIN
      PYRANG=PYMAX-PYMIN
C
      DO5100I=1,NP
      FXRATI=(PX(I)-FXMIN)/FXRANG
      FYRATI=(PY(I)-FYMIN)/FYRANG
      PX(I)=PXMIN+FXRATI*PXRANG
      PY(I)=PYMIN+FYRATI*PYRANG
 5100 CONTINUE
C
      DO5200I=1,NP
      PX(I)=PX(I)+PCH2HO
      PY(I)=PY(I)+PCH2VO
 5200 CONTINUE
C
C               ***********************************************
C               **  STEP 60--                                **
C               **  WRITE OUT THE MARKERS (PLOT CHARACTERS)  **
C               **  AT THE PLOT POINTS                       **
C               ***********************************************
C
      IFIG='GENE'
      IPATT=ICH2PA
      IFONT=ICH2FO
      ICASE=ICH2CA
      IJUST=ICH2JU
      IDIR=ICH2DI
      ANGLE=ACH2AN
      IFILL=ICH2FI
      ICOL=ICH2CO
      PHEIGH=PCH2HE
CCCCC PWIDTH=0.5*PHEIGH
CCCCC PWIDTH=PHEIGH*(ANUMVP/ANUMHP)      DECEMBER 1987  TEST
      PWIDTH=PCH2WI
      PVEGAP=PHEIGH/2.0
      PHOGAP=PWIDTH/2.0
      PTHICK=PCH2TH
      ISYMBL=ICH2PA
      ISPAC=ITEXSP
C
CCCCC ADD X3D TO CALL LIST.  JANUARY 2000.
      CALL DPCLCH(PX,PY,NP,PX2,PY2,NP2,X3D,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1ISORSW,
     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1IMPSW2,AMPSCH,AMPSCW,
     1ISYMBL,ISPAC)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRCH')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRCH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NP
 9012 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO9029
      DO9025I=1,3
      WRITE(ICOUT,9026)I,X(I),Y(I)
 9026 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      NPM2=NP-2
      DO9027I=NPM2,NP
      WRITE(ICOUT,9028)I,X(I),Y(I)
 9028 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9027 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9030)ISORSW
 9030 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992 (JJF)
      WRITE(ICOUT,9031)ARE2BA
 9031 FORMAT('ARE2BA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)ICH2PA
 9034 FORMAT('ICH2PA= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ICH2FO
 9035 FORMAT('ICH2FO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)ICH2JU
 9036 FORMAT('ICH2JU= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)ICH2DI
 9037 FORMAT('ICH2DI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)ACH2AN
 9038 FORMAT('ACH2AN= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)ICH2FI
 9039 FORMAT('ICH2FI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)ICH2CO
 9040 FORMAT('ICH2CO= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)PCH2HE
 9041 FORMAT('PCH2HE= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)PCH2WI
 9042 FORMAT('PCH2WI= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)PCH2TH,PCH2HO,PCH2VO
 9043 FORMAT('PCH2TH,PCH2HO,PCH2VO= ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)ITEXSP
 9044 FORMAT('ITEXSP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)PXMIN,PXMAX,PYMIN,PYMAX
 9045 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)FX1MIN,FX1MAX,FY1MIN,FY1MAX
 9046 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)FXMIN,FXMAX,FYMIN,FYMAX
 9047 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9048)IX1TSC,IY1TSC
 9048 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ISYMBL,ISPAC
 9051 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9059)IBUGG4,ISUBG4,IERRG4
 9059 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRFL(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
     1PFRATH)
C     PURPOSE--DRAW THE 4 (IF CALLED FOR) FRAME LINES ON THE SCREEN.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --SEPTEMBER 1987.  CALLS TO GRDRPL TO DPDRPL
C     UPDATED         --FEBRUARY  1988.  STAR PLOT
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IX1FSW
      CHARACTER*4 IX2FSW
      CHARACTER*4 IY1FSW
      CHARACTER*4 IY2FSW
C
      CHARACTER*4 IX1FPA
      CHARACTER*4 IX2FPA
      CHARACTER*4 IY1FPA
      CHARACTER*4 IY2FPA
C
      CHARACTER*4 IX1FCO
      CHARACTER*4 IX2FCO
      CHARACTER*4 IY1FCO
      CHARACTER*4 IY2FCO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
CCCCC DIMENSION PX3(10)
CCCCC DIMENSION PY3(10)
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
C-----START POINT-----------------------------------------------------
C
      NP=2
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
   52 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IX1FSW,IX2FSW,IY1FSW,IY2FSW
   55 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IX1FPA,IX2FPA,IY1FPA,IY2FPA
   56 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IX1FCO,IX2FCO,IY1FCO,IY2FCO
   57 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PFRATH
   58 FORMAT('PFRATH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IF(ICASPL.EQ.'PIEC')GOTO9000
      IF(ICASPL.EQ.'STAR')GOTO9000
      IF(ICAS3D.EQ.'ON')GOTO9000
C
      IFIG='LINE'
      PTHICK=PFRATH
C
C               **************************************
C               **  STEP 1--                        **
C               **  DRAW OUT THE BOTTOM FRAME LINE  **
C               **  (IF CALLED FOR)                 **
C               **************************************
C
      IF(IX1FSW.EQ.'ON')GOTO1100
      GOTO1190
 1100 CONTINUE
      PX(1)=PXMIN
      PY(1)=PYMIN
      PX(2)=PXMAX
      PY(2)=PYMIN
      NP=2
      IPATT=IX1FPA
      ICOL=IX1FCO
      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)
 1190 CONTINUE
C
C               *************************************
C               **  STEP 2--                       **
C               **  DRAW OUT THE RIGHT FRAME LINE  **
C               **  (IF CALLED FOR)                **
C               *************************************
C
      IF(IY2FSW.EQ.'ON')GOTO1200
      GOTO1290
 1200 CONTINUE
      PX(1)=PXMAX
      PY(1)=PYMIN
      PX(2)=PXMAX
      PY(2)=PYMAX
      NP=2
      IPATT=IY2FPA
      ICOL=IY2FCO
      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)
 1290 CONTINUE
C
C               ***********************************
C               **  STEP 3--                     **
C               **  DRAW OUT THE TOP FRAME LINE  **
C               **  (IF CALLED FOR)              **
C               ***********************************
C
      IF(IX2FSW.EQ.'ON')GOTO1300
      GOTO1390
 1300 CONTINUE
      PX(1)=PXMAX
      PY(1)=PYMAX
      PX(2)=PXMIN
      PY(2)=PYMAX
      NP=2
      IPATT=IX2FPA
      ICOL=IX2FCO
      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)
 1390 CONTINUE
C
C               *************************************
C               **  STEP 4--                       **
C               **  DRAW OUT THE LEFT  FRAME LINE  **
C               **  (IF CALLED FOR)                **
C               *************************************
C
      IF(IY1FSW.EQ.'ON')GOTO1400
      GOTO1490
 1400 CONTINUE
      PX(1)=PXMIN
      PY(1)=PYMAX
      PX(2)=PXMIN
      PY(2)=PYMIN
      NP=2
      IPATT=IY1FPA
      ICOL=IY1FCO
      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)
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)PXMIN,PYMIN,PXMAX,PYMAX
 9012 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IX1FSW,IX2FSW,IY1FSW,IY2FSW
 9015 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IX1FPA,IX2FPA,IY1FPA,IY2FPA
 9016 FORMAT('IX1FPA,IX2FPA,IY1FPA,IY2FPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IX1FCO,IX2FCO,IY1FCO,IY2FCO
 9017 FORMAT('IX1FCO,IX2FCO,IY1FCO,IY2FCO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)PFRATH
 9018 FORMAT('PFRATH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)NP
 9025 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9026I=1,NP
      WRITE(ICOUT,9027)PX(I),PY(I)
 9027 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9026 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRFR(ICASPL,ICAS3D,
     1IVGMSW,IHGMSW)
C
C     PURPOSE--DRAW FRAME LINES (ALONG WITH TIC MARKS,
C              TIC MARK LABELS, AND GRID LINES
C              FOR A PLOT.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     MODIFIED      --MAY         1990.   ADD OFFSET ARGUMENTS TO DPDRGL
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      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
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRFR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IMANUF,IMODEL
   52 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGG4,ISUBG4,IERRG4
   55 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************
C               **  STEP 1--                 **
C               **  FILL  THE MARGIN REGION  **
C               *******************************
C
      IF(IERASW.EQ.'ON'.AND.IMARCO.NE.IBACCO)
     1CALL DPFIMA(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IMARCO)
C
C               ****************************
C               **  STEP 2--              **
C               **  DRAW THE FRAME LINES  **
C               ****************************
C
      CALL DPDRFL(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
     1PFRATH)
C
C               **************************
C               **  STEP 3--            **
C               **  DRAW THE TIC MARKS  **
C               **************************
C
      CALL DPDRTM(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1PX1COO,PX2COO,PY1COO,PY2COO,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
     1PTICTH,PMNTFA,
     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
     1IX1TCO,IX2TCO,IY1TCO,IY2TCO)
C
C               *************************************
C               **  STEP 4--                       **
C               **  WRITE OUT THE TIC MARK LABELS  **
C               *************************************
C
      CALL DPWRTL(ICASPL,ICAS3D)
C
C               ***************************
C               **  STEP 5--             **
C               **  DRAW THE GRID LINES  **
C               ***************************
C
      CALL DPDRGL(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IVGRSW,IHGRSW,
     1IVGMSW,IHGMSW,
     1PX1COO,PX2COO,PY1COO,PY2COO,
     1X1COOR,X2COOR,Y1COOR,Y2COOR,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
     1X1COMN,X2COMN,Y1COMN,Y2COMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1IVGRPA,IHGRPA,IVGRCO,IHGRCO,
     1PVGRTH,PHGRTH,
     1PX1TOL,PX1TOR,PY1TOB,PY1TOT)
CCCC ABOVE LINE ADDED MAY, 1990 (FOR TIC OFFSETS)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRFR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRFR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGG4,ISUBG4,IERRG4
 9015 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRGL(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IVGRSW,IHGRSW,
     1IVGMSW,IHGMSW,
     1PX1COO,PX2COO,PY1COO,PY2COO,
     1X1COOR,X2COOR,Y1COOR,Y2COOR,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
     1X1COMN,X2COMN,Y1COMN,Y2COMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1IVGRPA,IHGRPA,IVGRCO,IHGRCO,
     1PVGRTH,PHGRTH,
     1PX1TOL,PX1TOR,PY1TOB,PY1TOT)
C
C     PURPOSE--DRAW GRID LINES ON A PLOT
C              FOR A GENERAL GRAPHICS DEVICE.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --SEPTEMBER 1987.   GRDRPL TO DPDRPL
C     UPDATED         --FEBRUARY  1988.   STAR PLOT
C     UPDATED         --MAY       1990.   TIC OFFSETS
C     UPDATED         --SEPTEMBER 1990.   MISSING HORIZ. GRID LINES
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IVGRSW
      CHARACTER*4 IHGRSW
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IVGRPA
      CHARACTER*4 IHGRPA
      CHARACTER*4 IVGRCO
      CHARACTER*4 IHGRCO
C
      CHARACTER*4 ITYPE
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
CCCCC CHARACTER*4 IHORPA
CCCCC CHARACTER*4 IVERPA
CCCCC CHARACTER*4 IDUPPA
CCCCC CHARACTER*4 IDDOPA
      CHARACTER*4 IFLAG
C
      DIMENSION PX1COO(*)
      DIMENSION PX2COO(*)
      DIMENSION PY1COO(*)
      DIMENSION PY2COO(*)
C
      DIMENSION X1COOR(*)
      DIMENSION X2COOR(*)
      DIMENSION Y1COOR(*)
      DIMENSION Y2COOR(*)
C
      DIMENSION PX1CMN(*)
      DIMENSION PX2CMN(*)
      DIMENSION PY1CMN(*)
      DIMENSION PY2CMN(*)
C
      DIMENSION X1COMN(*)
      DIMENSION X2COMN(*)
      DIMENSION Y1COMN(*)
      DIMENSION Y2COMN(*)
C
      DIMENSION PX(100)
      DIMENSION PY(100)
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.'DRGL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRGL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
   52 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IVGRSW,IHGRSW,IVGMSW,IHGMSW
   54 FORMAT('IVGRSW,IHGRSW,IVGMSW,IHGMSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IVGRPA,IHGRPA
   55 FORMAT('IVGRPA,IHGRPA = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PVGRTH,PHGRTH
   56 FORMAT('PVGRTH,PHGRTH = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IVGRCO,IHGRCO
   57 FORMAT('IVGRCO,IHGRCO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NX1COO,NX2COO,NY1COO,NY2COO
   60 FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
      CALL DPWRST('XXX','BUG ')
C
      IF(NX1COO.LE.0)GOTO69
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO61I=1,NX1COO
      WRITE(ICOUT,62)I,PX1COO(I),X1COOR(I)
   62 FORMAT('I,PX1COO(I),X1COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
C
      IF(NX2COO.LE.0)GOTO79
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO71I=1,NX2COO
      WRITE(ICOUT,72)I,PX2COO(I),X2COOR(I)
   72 FORMAT('I,PX2COO(I),X2COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
   79 CONTINUE
C
      IF(NY1COO.LE.0)GOTO89
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NY1COO
      WRITE(ICOUT,82)I,PY1COO(I),Y1COOR(I)
   82 FORMAT('I,PY1COO(I),Y1COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   89 CONTINUE
C
      IF(NY2COO.LE.0)GOTO99
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO91I=1,NY2COO
      WRITE(ICOUT,92)I,PY2COO(I),Y2COOR(I)
   92 FORMAT('I,PY2COO(I),Y2COOR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   91 CONTINUE
   99 CONTINUE
C
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
   90 CONTINUE
C
      IF(ICASPL.EQ.'PIEC')GOTO9000
      IF(ICASPL.EQ.'STAR')GOTO9000
      IF(ICAS3D.EQ.'ON')GOTO9000
C
      ITYPE='LINE'
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  TRANSLATE THE VERTICAL GRID LINE LINE PATTERN            **
C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
C               **  BY THE GRAPHICS DEVICE.                      **
C               ***************************************************
C
      IPATT=IVGRPA
CCCCC CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************
C               **  STEP 2--                    **
C               **  SET THE LINE PATTERN TO SOLID  **
C               **  ON THE GRAPHICS DEVICE.     **
C               **********************************
C
CCCCC CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 3--                                  **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE VERTICAL GRID LINE   COLOR
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=IVGRCO
CCCCC CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE  COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSECO(ITYPE,ICOL,JCOL)
C
C               **********************************************
C               **  STEP 5--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE VERTICAL GRID LINE THICKNESS                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      PTHICK=PVGRTH
CCCCC CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 6--                 **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               **********************************
C               **  STEP 7--                    **
C               **  DRAW VERTICAL   GRID LINES  **
C               **********************************
C
      IFIG='LINE'
      PY(1)=PYMIN
      PY(2)=PYMAX
C
      IF(IVGRSW.EQ.'OFF')GOTO1140
      IF(NX1COO.LE.2)GOTO1140
CCCCC MAY, 1990.  IF TIC OFFSETS ARE NON-ZER0, DRAW THE FIRST AND
CCCCC LAST GRID LINES (WHICH PREVIOUSLY WOULD ALWAYS BE ON THE FRAME.
      EPS=0.000001
      IMIN=2
      IF(ABS(PX1TOL).GE.EPS)IMIN=1
      IMAX=NX1COO-1
      IF(ABS(PX1TOR).GE.EPS)IMAX=NX1COO
      NP=2
CCCCC IMAX=NX1COO-1
      IFLAG='ON'
CCCCC DO1110I=2,IMAX
      DO1110I=IMIN,IMAX
      PX(1)=PX1COO(I)
      PX(2)=PX1COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      IFLAG='OFF'
 1110 CONTINUE
 1140 CONTINUE
C
      IF(IVGMSW.EQ.'OFF')GOTO1180
      IF(NX1CMN.LE.2)GOTO1180
      NP=2
      IMAX=NX1CMN
      IFLAG='ON'
      DO1150I=1,IMAX
      PX(1)=PX1CMN(I)
      PX(2)=PX1CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      IFLAG='OFF'
 1150 CONTINUE
 1180 CONTINUE
C
 1190 CONTINUE
C
C               ***************************************************
C               **  STEP 11--                                    **
C               **  TRANSLATE THE HORIZONTAL GRID LINE LINE PATTERN            *
C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
C               **  BY THE GRAPHICS DEVICE.                      **
C               ***************************************************
C
      IPATT=IHGRPA
CCCCC CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************
C               **  STEP 12--                    **
C               **  SET THE LINE PATTERN TO SOLID  **
C               **  ON THE GRAPHICS DEVICE.     **
C               **********************************
C
CCCCC CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
CCCCC1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 13--                                  **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE HORIZONTAL GRID LINE   COLOR
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=IHGRCO
CCCCC CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 14--                **
C               **  SET THE  COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSECO(ITYPE,ICOL,JCOL)
C
C               **********************************************
C               **  STEP 15--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE HORIZONAL GRID LINE THICKNESS                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      PTHICK=PHGRTH
CCCCC CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 16--                 **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
CCCCC CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               **********************************
C               **  STEP 17--                   **
C               **  DRAW HORIZONTAL GRID LINES  **
C               **********************************
C
      IFIG='LINE'
      PX(1)=PXMIN
      PX(2)=PXMAX
C
      IF(IHGRSW.EQ.'OFF')GOTO1240
      IF(NY1COO.LE.2)GOTO1240
      NP=2
CCCCC MAY, 1990.  IF TIC OFFSETS ARE NON-ZER0, DRAW THE FIRST AND
CCCCC LAST GRID LINES (WHICH PREVIOUSLY WOULD ALWAYS BE ON THE FRAME.
      EPS=0.000001
      IMIN=2
      IF(ABS(PY1TOB).GE.EPS)IMIN=1
CCCCC THE FOLLOWING LINE WAS FIXED SEPTEMBER 1990
CCCCC IMAX=NX1COO-1
      IMAX=NY1COO-1
      IF(ABS(PY1TOT).GE.EPS)IMAX=NY1COO
CCCCC IMAX=NY1COO-1
      IFLAG='ON'
CCCCC DO1210I=2,IMAX
      DO1210I=IMIN,IMAX
      PY(1)=PY1COO(I)
      PY(2)=PY1COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      IFLAG='OFF'
 1210 CONTINUE
 1240 CONTINUE
C
      IF(IHGMSW.EQ.'OFF')GOTO1280
      IF(NY1CMN.LE.2)GOTO1280
      NP=2
      IMAX=NY1CMN
      IFLAG='ON'
      DO1250I=1,IMAX
      PY(1)=PY1CMN(I)
      PY(2)=PY1CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      IFLAG='OFF'
 1250 CONTINUE
 1280 CONTINUE
C
 1290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRGL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRGL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
 9020 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL,JCOL
 9021 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)ITYPE
 9022 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C  MODIFIED SEPTEMBER, 1987
CCCCC SUBROUTINE DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              DRAW THE POLYLINE WHOSE COORDINATES
C              ARE GIVEN IN (PX(.),PY(.)) ,
C              AND WHICH HAS SPECIFIED
C              PATTERN, THICKNESS, AND COLOR.
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
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-921-369011
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --JANUARY   1989.  MODIFED CALL LIST (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFIED LINE THICKNESS ALGOR. (ALAN)
C     UPDATED         --MAY       1989.  DEBUG FOR IFLAG
C     UPDATED         --MAY       1995.  USE EQUIVALENCE
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
C
      CHARACTER*4 ITYPE
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 IFLAG
C
      DIMENSION PX(*)
      DIMENSION PY(*)
CCCCC DIMENSION PX3(*)
CCCCC DIMENSION PY3(*)
      INCLUDE 'DPCOPA.INC'
      DIMENSION PX3(MAXPOP)
      DIMENSION PY3(MAXPOP)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZ2.INC'
CCCCC EQUIVALENCE (G2RBAG(IGAR42),PX3(1))
CCCCC EQUIVALENCE (G2RBAG(IGAR43),PY3(1))
CCCCC END CHANGE
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.'DRPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAX(10,NP)
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,58)IFIG,IPATT,PTHICK,ICOL
   58 FORMAT('IFIG,IPATT,PTHICK,ICOL = ',A4,2X,A4,2X,E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)JTHICK,PTHICK,PTHIC2
   59 FORMAT('JTHICK,PTHIC,PTHIC2 = ',I8,2G15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992
      WRITE(ICOUT,62)IFLAG
   62 FORMAT('IFLAG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C  SEPTEMMBER, 1987 - SET ATTRIBUTES ACCORDING TO FLAG
      NP3=NP
      IF(IFLAG.EQ.'OFF')GOTO700
C
      ITYPE='LINE'
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE LINE PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE  DESIRED                  **
C               **  LINE THICKNESS                          **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               **********************************************
C               **  STEP 901--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 6--                 **
C               **  SET THE LINE COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
C               *****************************
C               **  STEP 7--               **
C               **  DRAW OUT THE POLYLINE  **
C               *****************************
C
  700 CONTINUE
      IF(IFLAG.EQ.'LOOP')GOTO800
      CALL GRDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL)
C
CCCCC PPENTH=0.1
CCCCC NLOOP=((PTHICK/(2.0*PPENTH))-1.0)+0.1
C
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')
CCCCC1WRITE(ICOUT,1510)PPENTH,NLOOP
C1510 FORMAT('PPENTH,NLOOP = ',E15.7,I8)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')
CCCCC1CALL DPWRST('XXX','BUG ')
C
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
        WRITE(ICOUT,1510)PTHIC2,JTHICK
 1510   FORMAT('PTHIC2,JTICK = ',E15.7,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
  800 CONTINUE
      NLOOP=JTHICK
      PPENTH=PTHIC2
C
      IF(NLOOP.LE.0)GOTO1590
      DO1520I=1,NLOOP
      AI=I
C
      DEL=PPENTH*AI
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
        WRITE(ICOUT,1522)I,NLOOP,DEL
 1522   FORMAT('I,NLOOP,DEL = ',2I8,G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
      CALL GRDRPL(PX3,PY3,NP3,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL)
C
      DEL=(-PPENTH*AI)
      CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
      CALL GRDRPL(PX3,PY3,NP3,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL)
C
 1520 CONTINUE
C
 1590 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,MAX(10,NP)
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9018)IFIG
 9018 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
 9020 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL,JCOL
 9021 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED MAY 1992
      WRITE(ICOUT,9022)IFLAG
 9022 FORMAT('IFLAG = ',A4)
      CALL DPWRST('XXX','BUG ')
 
      WRITE(ICOUT,9023)ITYPE
 9023 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)PPENTH,DEL,NLOOP
 9024 FORMAT('PPENTH,DEL,NLOOP = ',2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRPM(PX,PY,NP,X3D2,IJUNK2,IROWID,IROWLB,
     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1IMPSW2,AMPSCH,AMPSCW,
     1ISYMBL,ISPAC)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              DRAW THE POLYMARKERS WHOSE COORDINATES
C              ARE GIVEN IN (PX(.),PY(.)) ,
C              AND WHICH HAS SPECIFIED
C              MARKER TYPE, SIZE, FONT, JUSTIFICATION, COLOR, ANGLE,
C              AND LINE THICKNESS.
C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
C           STANDARDIZED (0.0 TO 100.0) UNITS.
C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
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-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED       --NOVEMBER   1995.  SUPPORT FOR CASE ASIS
C     UPDATED       --SEPTEMBER  1999.  GRDRPM ARGUMENT LIST
C     UPDATED       --DECEMBER   1999.  SUPPORT SPECIAL PLOTTING
C                                       (FOR VALUE OF POINT,ETC.)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ITYPE
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 ITYPSV
C
      CHARACTER*4 ICTEMP
      CHARACTER*4 ICTEXT
      CHARACTER*4 IERROR
C
      CHARACTER*24 IROWLB
C
      DIMENSION ICTEXT(50)
C
      DIMENSION IROWID(*)
      DIMENSION IROWLB(*)
      DIMENSION IJUNK2(*)
      DIMENSION PX(*)
      DIMENSION PY(*)
      DIMENSION X3D2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      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
      IERROR='OFF'
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPM')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRPM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NP
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      WRITE(ICOUT,56)PX(I),PY(I)
   56 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,58)IFIG
   58 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT
   59 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IFONT
   62 FORMAT('IFONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IJUST
   63 FORMAT('IJUST = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IDIR,ANGLE
   64 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILL
   65 FORMAT('IFILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL
   66 FORMAT('ICOL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,PWIDTH
   67 FORMAT('PHEIGH,PWIDTH = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PVEGAP,PHOGAP
   68 FORMAT('PVEGAP,PHOGAP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTHICK
   69 FORMAT('PTHICK = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ISYMBL,ISPAC
   71 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      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
CCCCC DECEMBER 1999.  SUPPORT SPECIAL CASES:
CCCCC 1) XVAL  = X-COORDINATE OF VARIABLE
CCCCC 2) YVAL  = Y-COORDINATE OF VARIABLE
CCCCC 3) XYVA  = (X,Y) OF VARIABLE
CCCCC 4) ROWI  = ROW-ID
CCCCC 5) ROWL  = ROW-LABEL
CCCCC 6) TVAL  = TAG-VALUE (SPECIAL CASE FOR CROSS-TABULATE PLOT,
CCCCC            BUT MAY HAVE OTHER USES AS WELL)
CCCCC 7) ZVAL  = USE VALUE IN X3D2
C
      IF(
     1(ISYMBL(1:1).EQ.'R'.OR.ISYMBL(1:1).EQ.'r').AND.
     1(ISYMBL(2:2).EQ.'O'.OR.ISYMBL(2:2).EQ.'o').AND.
     1(ISYMBL(3:3).EQ.'W'.OR.ISYMBL(3:3).EQ.'w').AND.
     1(ISYMBL(4:4).EQ.'I'.OR.ISYMBL(4:4).EQ.'i')
     1)THEN
        DO1010I=1,NP
          IROW=IROWID(I)
          AROW=REAL(IROW)
          NCTEXT=0
          DO1015J=1,50
            ICTEXT(J)=' '
 1015     CONTINUE
          CALL DPCONH(IROW,AROW,ICTEXT,NH,IBUGG4,IERROR)
          NCTEXT=NH
          PX1=PX(I)
          PY1=PY(I)
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1010   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'R'.OR.ISYMBL(1:1).EQ.'r').AND.
     1(ISYMBL(2:2).EQ.'O'.OR.ISYMBL(2:2).EQ.'o').AND.
     1(ISYMBL(3:3).EQ.'W'.OR.ISYMBL(3:3).EQ.'w').AND.
     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
     1)THEN
        DO1020I=1,NP
          ITEMP=IROWID(I)
          IF(IROWLB(ITEMP).EQ.' ')THEN
            IROW=IROWID(I)
            AROW=REAL(IROW)
            NCTEXT=0
            DO1025J=1,50
              ICTEXT(J)=' '
 1025       CONTINUE
            CALL DPCONH(IROW,AROW,ICTEXT,NH,IBUGG4,IERROR)
            NCTEXT=NH
          ELSE
            NCTEXT=1
            DO1026J=24,1,-1
              IF(IROWLB(ITEMP)(J:J).NE.' ')THEN
                NCTEXT=J
                GOTO1027
              ENDIF
 1026       CONTINUE
 1027       CONTINUE
            DO1028J=1,NCTEXT
              ICTEXT(J)(1:1)=IROWLB(ITEMP)(J:J)
 1028       CONTINUE
          ENDIF
          PX1=PX(I)
          PY1=PY(I)
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1020   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'X'.OR.ISYMBL(1:1).EQ.'x').AND.
     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
     1)THEN
        DO1030I=1,NP
          PX1=PX(I)
          PY1=PY(I)
          AVAL=X(I)
          CONST=0.5
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          NCTEXT=0
          DO1035J=1,50
            ICTEXT(J)=' '
 1035     CONTINUE
          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
          NCTEXT=NH
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1030   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'Y'.OR.ISYMBL(1:1).EQ.'y').AND.
     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
     1)THEN
        DO1040I=1,NP
          PX1=PX(I)
          PY1=PY(I)
          AVAL=Y(I)
          CONST=0.5
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          NCTEXT=0
          DO1045J=1,50
            ICTEXT(J)=' '
 1045     CONTINUE
          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
          NCTEXT=NH
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1040   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'X'.OR.ISYMBL(1:1).EQ.'x').AND.
     1(ISYMBL(2:2).EQ.'Y'.OR.ISYMBL(2:2).EQ.'y').AND.
     1(ISYMBL(3:3).EQ.'V'.OR.ISYMBL(3:3).EQ.'v').AND.
     1(ISYMBL(4:4).EQ.'A'.OR.ISYMBL(4:4).EQ.'a')
     1)THEN
        DO1050I=1,NP
          DO1055J=1,50
            ICTEXT(J)=' '
 1055     CONTINUE
          PX1=PX(I)
          PY1=PY(I)
          AVAL=X(I)
          CONST=0.5
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          NCTEXT=1
          ICTEXT(NCTEXT)(1:1)='('
          NCTEXT=NCTEXT+1
          CALL DPCONH(IVAL,AVAL,ICTEXT(NCTEXT),NH,IBUGG4,IERROR)
          NCTEXT=NCTEXT+NH
          NCTEXT=NCTEXT+1
          ICTEXT(NCTEXT)(1:1)=','
          NCTEXT=NCTEXT+1
          AVAL=Y(I)
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          CALL DPCONH(IVAL,AVAL,ICTEXT(NCTEXT),NH,IBUGG4,IERROR)
          NCTEXT=NCTEXT+NH
          ICTEXT(NCTEXT)(1:1)=')'
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1050   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'T'.OR.ISYMBL(1:1).EQ.'t').AND.
     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
     1)THEN
        DO1060I=1,NP
          PX1=PX(I)
          PY1=PY(I)
          AVAL=D(I)
          CONST=0.5
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          NCTEXT=0
          DO1065J=1,50
            ICTEXT(J)=' '
 1065     CONTINUE
          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
          NCTEXT=NH
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
 1060   CONTINUE
        GOTO9000
      ELSEIF(
     1(ISYMBL(1:1).EQ.'Z'.OR.ISYMBL(1:1).EQ.'z').AND.
     1(ISYMBL(2:2).EQ.'V'.OR.ISYMBL(2:2).EQ.'v').AND.
     1(ISYMBL(3:3).EQ.'A'.OR.ISYMBL(3:3).EQ.'a').AND.
     1(ISYMBL(4:4).EQ.'L'.OR.ISYMBL(4:4).EQ.'l')
     1)THEN
        J=0
        DO1070I=1,MAXPOP
          IF(IJUNK2(I).EQ.0)GOTO1070
          J=J+1
          PX1=PX(J)
          PY1=PY(J)
          AVAL=X3D2(I)
          CONST=0.5
          IF(AVAL.LT.0.0)CONST=-0.5
          IVAL=INT(AVAL+CONST)
          NCTEXT=0
          DO1075JJ=1,50
            ICTEXT(JJ)=' '
 1075     CONTINUE
          CALL DPCONH(IVAL,AVAL,ICTEXT,NH,IBUGG4,IERROR)
          NCTEXT=NH
          CALL DPWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1                IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1                PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1                ISYMBL,ISPAC,
     1                IMPSW2,AMPSCH,AMPSCW,
     1                PX99,PY99)
          IF(J.GE.NP)GOTO1079
 1070   CONTINUE
 1079   CONTINUE
        GOTO9000
      ENDIF
CCCCC NOVEMBER 1995. DO CASE CONVERSION HERE.
CCCCC IF "ASIS" NO ACTION REQUIRED.
CCCCC BE SURE TO TRANSLATE IPATT TO UPPER CASE.
      IF(ICASE.EQ.'LOWE')THEN
        DO100I=1,4
        ICTEMP=ISYMBL(I:I)
        CALL DPCOAN(ICTEMP,IVALT)
        IF(IVALT.GE.65.AND.IVALT.LE.90)IVALT=IVALT+32
        CALL DPCONA(IVALT,ICTEMP)
        ISYMBL(I:I)=ICTEMP
  100   CONTINUE
      ELSEIF(ICASE.EQ.'UPPE')THEN
        DO110I=1,4
        ICTEMP=ISYMBL(I:I)
        CALL DPCOAN(ICTEMP,IVALT)
        IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
        CALL DPCONA(IVALT,ICTEMP)
        ISYMBL(I:I)=ICTEMP
  110   CONTINUE
      ELSEIF(ICASE.EQ.'ASIS')THEN
        CONTINUE
      END IF
      DO130I=1,4
      ICTEMP=IPATT(I:I)
      CALL DPCOAN(ICTEMP,IVALT)
      IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
      CALL DPCONA(IVALT,ICTEMP)
      IPATT(I:I)=ICTEMP
  130 CONTINUE
C
      ITYPE='MARK'
C
C               **********************************************
C               **  STEP 1--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE MARKER PATTERN (TYPE)            **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 2--                 **
C               **  SET THE MARKER PATTERN   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE MARKER FONT                      **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRFO(ITYPE,IFONT,JFONT)
C
C               ************************************
C               **  STEP 4--                      **
C               **  SET THE MARKER FONT           **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSEFO(ITYPE,IFONT,JFONT)
C
C               **********************************************
C               **  STEP 5--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE MARKER CASE (UPPER OR LOWER)     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRCA(ITYPE,ICASE,JCASE)
C
C               ************************************
C               **  STEP 6--                      **
C               **  SET THE MARKER CASE           **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSECA(ITYPE,ICASE,JCASE)
C
C               **********************************************
C               **  STEP 7--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE MARKER JUSTIFICATION             **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRJU(ITYPE,IJUST,JJUST)
C
C               ************************************
C               **  STEP 8--                      **
C               **  SET THE MARKER JUSTIFICATION  **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSEJU(ITYPE,IJUST,JJUST)
C
C               **********************************************
C               **  STEP 9--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION **
C               **  OF THE MARKER DIRECTION (ANGLE)         **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
C               ************************************
C               **  STEP 10--                    **
C               **  SET THE MARKER DIRECTION     **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSEDI(ITYPE,IDIR,ANGLE,JDIR,ANGLE2)
C
C               **********************************************
C               **  STEP 11--                              **
C               **  TRANSLATE THE CHARACTER REPRESENTATION **
C               **  OF THE MARKER FILL (ON/OFF)                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRFI(ITYPE,IFILL,JFILL)
C
C               *******************************
C               **  STEP 12--                **
C               **  SET THE MARKER FILL      **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEFI(ITYPE,IFILL,JFILL)
C
C               **********************************************
C               **  STEP 13--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE MARKER COLOR                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ITYPSV=ITYPE
      IF(IFONT.EQ.'TEKT')ITYPE='TEXT'
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      ITYPE=ITYPSV
C
C               *******************************
C               **  STEP 14--                **
C               **  SET THE MARKER COLOR     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      ITYPSV=ITYPE
      IF(IFONT.EQ.'TEKT')ITYPE='TEXT'
      CALL GRSECO(ITYPE,ICOL,JCOL)
      ITYPE=ITYPSV
C
C               **********************************************
C               **  STEP 15--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION   **
C               **  OF THE MARKER SIZE                      **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRSI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C               ************************************
C               **  STEP 16--                      **
C               **  SET THE MARKER SIZE            **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSESI(ITYPE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2)
C
C               **********************************************
C               **  STEP 17--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION   **
C               **  OF THE MARKER LINE THICKNESS            **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               ************************************
C               **  STEP 18--                      **
C               **  SET THE MARKER LINE THICKNESS  **
C               **  ON THE GRAPHICS DEVICE.       **
C               ************************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 19--                **
C               **  DRAW OUT THE POLYMARKER  **
C               *******************************
C
      CALL GRDRPM(PX,PY,NP,
     1IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PTHICK,JTHICK,PTHIC2,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1IMPSW2,AMPSCH,AMPSCW,
     1ISYMBL,ISPAC)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRPM')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRPM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)PX(I),PY(I)
 9016 FORMAT('PX(I),PY(I) = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9018)IFIG
 9018 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFONT,JFONT
 9022 FORMAT('IFONT,JFONT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IJUST,JJUST
 9023 FORMAT('IJUST,JJUST = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)IDIR,ANGLE,JDIR,ANGLE2
 9024 FORMAT('IDIR,ANGLE,JDIR,ANGLE2 = ',A4,2X,E15.7,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILL,JFILL
 9025 FORMAT('IFILL,JFILL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9027 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9028 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PTHICK,PTHIC2
 9029 FORMAT('PTHICK,PTHIC2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISYMBL,ISPAC
 9031 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRSP(Y,X,PY,PX,NP,
     1ICASPL,ICAS3D,
     1ISORSW,
     1ISP2LI,ISP2CO,ISP2DI,PSP2TH,ASP2BA,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1IX1TSC,IY1TSC)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              AND FOR EACH VALUE IN X(.), DRAW A SPIKE
C              (= A VERTICAL OR HORIZONTAL LINE SEGMENT)
C              FROM THE BASE POINT ASP2BA
C              TO THE POINT Y(.).
C              DO SO FOR A SPECIFIED SPIKE LINE TYPE,
C              LINES COLOR, LINE DIRECTION, AND LINE THICKNESS.
C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
C           BACK IN THE MAIN ROUTINE.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED--APRIL     1987.
C     UPDATED         --SEPTEMBER 1988.  RENUMBER
C     UPDATED         --FEBRUARY  1989.  CHANGE CALLS FROM GRDRPL TO DPDRPL (ALA
C     UPDATED         --JULY      1990.  CHARACTER*4 IPATT TO FIX BOMB
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 ISORSW
C
      CHARACTER*4 ISP2LI
      CHARACTER*4 ISP2CO
      CHARACTER*4 ISP2DI
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IY1TSC
C
      CHARACTER*4 ITYPE
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATTT
CCCCC THE FOLLOWING LINE WAS ADDED TO FIX SPIKE BOMB   JULY 1990
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 IDIR
C
C     6/23/86
C     HOW COME THE FOLLOWING 4 VARIABLES ARE NOT CARRIED
C     AS INPUT TO THIS SUBROUTINE--NOT NEEDED???
C     CHECK ON THIS.
C
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
      CHARACTER*4 IFLAG
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION PY(*)
      DIMENSION PX(*)
C
      DIMENSION PY2(10)
      DIMENSION PX2(10)
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
      HOLD=1.0
      ABASE=0.0
      PBASE=0.0
      PBASE2=0.0
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      FYMIN=FY1MIN
      FYMAX=FY1MAX
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED TO FIX SPIKE BOMB JULY 1990
      IPATT='JUNK'
      JPATT=(-888)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NP
   52 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO69
      DO65I=1,3
      WRITE(ICOUT,66)I,X(I),Y(I)
   66 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      NPM2=NP-2
      DO67I=NPM2,NP
      WRITE(ICOUT,68)I,X(I),Y(I)
   68 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   67 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,70)ISORSW
   70 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ISP2LI
   71 FORMAT('ISP2LI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ISP2CO,ISP2DI
   72 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PSP2TH
   73 FORMAT('PSP2TH= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ASP2BA
   74 FORMAT('ASP2BA= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IX1TSC,IY1TSC
   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************************
C               **  STEP 11--                                  **
C               **  IF CALLED FOR, SORT THE DATA               **
C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
C               *************************************************
C
      IDIR=ISP2DI
C
      IF(ISORSW.EQ.'OFF')GOTO1150
      IF(ICASPL.EQ.'PIEC')GOTO1150
      IF(ICAS3D.EQ.'ON')GOTO1150
      IF(ICASPL.EQ.'CONT')GOTO1150
C
      CALL SORTC2(X,Y,NP,PX,PY)
      GOTO1190
C
 1150 CONTINUE
      DO1160I=1,NP
      PX(I)=X(I)
      PY(I)=Y(I)
 1160 CONTINUE
      GOTO1190
C
 1190 CONTINUE
C
C               ************************************************
C               **  STEP 12--                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,        **
C               **  CHECK THAT ALL DATA POINTS ARE POSITIVE.  **
C               ************************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO1210
      GOTO1290
C
 1210 CONTINUE
      IF(IDIR.EQ.'H')GOTO1215
      GOTO1219
 1215 CONTINUE
      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
      IF(ASP2BA.LE.0.0)GOTO1250
 1219 CONTINUE
C
      IF(ISORSW.EQ.'ON')GOTO1220
      GOTO1230
C
 1220 CONTINUE
      J=1
      IF(PX(J).LE.0.0)GOTO1250
      GOTO1290
C
 1230 CONTINUE
      DO1235I=1,NP
      J=I
      IF(PX(J).LE.0.0)GOTO1250
 1235 CONTINUE
      GOTO1290
C
 1250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1251)
 1251 FORMAT('***** ERROR IN DPDRSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1252)
 1252 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1253)
 1253 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1254)
 1254 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1255)
 1255 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1256)PX(J)
 1256 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1257)
 1257 FORMAT('      THIS VALUE CAME FROM THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1258)
 1258 FORMAT('      HORIZONTAL AXIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1259)
 1259 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1260)
 1260 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
 1290 CONTINUE
C
      IF(IY1TSC.EQ.'LOG')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      IF(IDIR.EQ.'V')GOTO1315
      GOTO1319
 1315 CONTINUE
      IF(ASP2BA.LE.0.0)HOLD=ASP2BA
      IF(ASP2BA.LE.0.0)GOTO1350
 1319 CONTINUE
C
      IF(ISORSW.EQ.'ON')GOTO1320
      GOTO1330
C
 1320 CONTINUE
      J=1
      IF(PY(J).LE.0.0)HOLD=PY(J)
      IF(PY(J).LE.0.0)GOTO1350
      GOTO1390
C
 1330 CONTINUE
      DO1335I=1,NP
      J=I
      IF(PY(J).LE.0.0)HOLD=PY(J)
      IF(PY(J).LE.0.0)GOTO1350
 1335 CONTINUE
      GOTO1390
C
 1350 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1351)
 1351 FORMAT('***** ERROR IN DPDRSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1352)
 1352 FORMAT('      THE LOG OF A NON-POSITIVE DATA VALUE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1353)
 1353 FORMAT('      WAS ENCOUNTERED IN FORMING A PLOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1354)
 1354 FORMAT('      DATA MAY NOT BE ZERO OR NEGATIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1355)
 1355 FORMAT('      WHEN A LOG SCALE PLOT IS USED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1356)HOLD
 1356 FORMAT('      THE VALUE = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1357)
 1357 FORMAT('      THIS VALUE CAME FROM THE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1358)
 1358 FORMAT('      VERTICAL AXIS VARIABLE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1359)
 1359 FORMAT('      CORRECTIVE ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1360)
 1360 FORMAT('      CHANGE DATA OR CHANGE LIMITS.')
      CALL DPWRST('XXX','BUG ')
      IERRG4='YES'
      GOTO9000
C
 1390 CONTINUE
C
C               ******************************************
C               **  STEP 40--                           **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      ABASE=ASP2BA
C
      IF(IX1TSC.EQ.'LOG')GOTO4010
      GOTO4019
 4010 CONTINUE
      IF(IDIR.EQ.'H')ABASE=ALOG10(ABASE)
      DO4015I=1,NP
      PX(I)=ALOG10(PX(I))
 4015 CONTINUE
 4019 CONTINUE
C
      IF(IY1TSC.EQ.'LOG')GOTO4020
      GOTO4029
 4020 CONTINUE
      IF(IDIR.EQ.'V')ABASE=ALOG10(ABASE)
      DO4025I=1,NP
      PY(I)=ALOG10(PY(I))
 4025 CONTINUE
 4029 CONTINUE
C
C               *****************************************************
C               **  STEP 50--                                      **
C               **  TRANSLATE THE DATA POINTS                      **
C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
C               *****************************************************
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      IF(IX1TSC.EQ.'LOG')FXMIN=ALOG10(FX1MIN)
      IF(IX1TSC.EQ.'LOG')FXMAX=ALOG10(FX1MAX)
C
      FYMIN=FY1MIN
      FYMAX=FY1MAX
      IF(IY1TSC.EQ.'LOG')FYMIN=ALOG10(FY1MIN)
      IF(IY1TSC.EQ.'LOG')FYMAX=ALOG10(FY1MAX)
C
      FXRANG=FXMAX-FXMIN
      FYRANG=FYMAX-FYMIN
      PXRANG=PXMAX-PXMIN
      PYRANG=PYMAX-PYMIN
C
      DO5000I=1,NP
      FXRATI=(PX(I)-FXMIN)/FXRANG
      FYRATI=(PY(I)-FYMIN)/FYRANG
      PX(I)=PXMIN+FXRATI*PXRANG
      PY(I)=PYMIN+FYRATI*PYRANG
 5000 CONTINUE
C
      IF(IDIR.EQ.'V')GOTO5010
      GOTO5019
 5010 CONTINUE
      FYRATI=(ABASE-FYMIN)/FYRANG
      PBASE=PYMIN+FYRATI*PYRANG
 5019 CONTINUE
C
      IF(IDIR.EQ.'H')GOTO5020
      GOTO5029
 5020 CONTINUE
      FXRATI=(ABASE-FXMIN)/FXRANG
      PBASE=PXMIN+FXRATI*PXRANG
 5029 CONTINUE
C
C               *******************************
C               **  STEP 70--                **
C               **  PREPARE TO MAKE VARIOUS  **
C               **  LINE SETTINGS            **
C               *******************************
C
      ITYPE='LINE'
C
C               **********************************************
C               **  STEP 71--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE PATTERN                     **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      IPATTT=ISP2LI
      CALL GRTRPA(ITYPE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               *******************************
C               **  STEP 72--                **
C               **  SET THE LINE PATTERN     **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSEPA(ITYPE,IPATTT,PXSPA,PYSPA,
     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 73--                               **
C               **  TRANSLATE THE  DESIRED                  **
C               **  LINE THICKNESS                          **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      PTHICK=PSP2TH
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 74--                **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               **********************************************
C               **  STEP 75--                               **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE LINE COLOR                       **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      ICOL=ISP2CO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
C
C               *******************************
C               **  STEP 76--                **
C               **  SET THE LINE COLOR       **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
C               **************************************
C               **  STEP 81--                       **
C               **  DRAW OUT ALL SPIKES             **
C               **  (BUT CLIP FIRST, IF NECESSARY)  **
C               **************************************
C
      IFIG='GENE'
C
      CALL DPSQUE(PX,PY,NP,
     1PXMIN,PXMAX,PYMIN,PYMAX)
C
      IF(IDIR.EQ.'V')GOTO7100
      GOTO7190
 7100 CONTINUE
      PBASE2=PBASE
      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
C
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
      IFLAG='OFF'
      NP2=2
      DO7110I=1,NP
C
      IF(PX(I).LT.PXMIN)GOTO7110
      IF(PX(I).GT.PXMAX)GOTO7110
      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO7110
      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO7110
C
      PX2(1)=PX(I)
      PX2(2)=PX(I)
C
      PY2(1)=PBASE2
      PY2(2)=PY(I)
C
      DO7150J=1,NP2
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 7150 CONTINUE
C
CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT FEBRUARY 1989
CCCCC AND REPLACED BY THE SUBSEQUENT 3 LINES (ALAN) FEBRUARY 1989
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATTT,PTHICK,ICOL,
CCCCC1JPATTT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
CCCCC THE FOLLOWING LINE WAS TEMPORARILY FIXED JULY 9, 1990
CCCCC1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
     1JPATTT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C
 7110 CONTINUE
 7190 CONTINUE
C
      IF(IDIR.EQ.'H')GOTO7200
      GOTO7290
 7200 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1989
      IFLAG='OFF'
      PBASE2=PBASE
      IF(PBASE2.LT.PXMIN.AND.(PXMIN-PBASE2).LE.0.0001)PBASE2=PXMIN
      IF(PBASE2.GT.PXMAX.AND.(PBASE2-PXMAX).LE.0.0001)PBASE2=PXMAX
C
      NP2=2
      DO7210I=1,NP
C
      IF(PY(I).LT.PYMIN)GOTO7210
      IF(PY(I).GT.PYMAX)GOTO7210
      IF(PX(I).LT.PXMIN.AND.PBASE2.LT.PXMIN)GOTO7210
      IF(PX(I).GT.PXMAX.AND.PBASE2.GT.PXMAX)GOTO7210
C
      PX2(1)=PBASE2
      PX2(2)=PX(I)
C
      PY2(1)=PY(I)
      PY2(2)=PY(I)
C
      DO7250J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
 7250 CONTINUE
C
CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT FEBRUARY 1989
CCCCC AND REPLACED BY THE SUBSEQUENT 3 LINES (ALAN) FEBRUARY 1989
CCCCC CALL GRDRPL(PX2,PY2,NP2,
CCCCC1IFIG,IPATTT,PTHICK,ICOL,
CCCCC1JPATTT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,ICOL,
CCCCC THE FOLLOWING LINE WAS TEMPORARILY FIXED JULY 9, 1990
CCCCC1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
     1JPATTT,JTHICK,PTHIC2,JCOL,IFLAG)
C
 7210 CONTINUE
 7290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRSP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NP
 9012 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)HOLD
 9014 FORMAT('HOLD = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ABASE,PBASE,PBASE2
 9015 FORMAT('ABASE,PBASE,PBASE2 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO9029
      DO9025I=1,3
      WRITE(ICOUT,9026)I,X(I),Y(I)
 9026 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      NPM2=NP-2
      DO9027I=NPM2,NP
      WRITE(ICOUT,9028)I,X(I),Y(I)
 9028 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9027 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9030)ISORSW
 9030 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ISP2LI
 9031 FORMAT('ISP2LI= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)PSP2TH
 9032 FORMAT('PSP2TH= ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)ISP2CO,ISP2DI
 9033 FORMAT('ISP2CO,ISP2DI= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)IX1TSC,IY1TSC
 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IFIG
 9051 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE AUGMENTED JULY 1990
CCCCC WRITE(ICOUT,9052)IPATTT,JPATTT
C9052 FORMAT('IPATTT,JPATTT = ',A4,I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IPATT,IPATTT,JPATTT
 9052 FORMAT('IPATT,IPATTT,JPATTT = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)PTHICK,JTHICK,PTHIC2
 9053 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9054)ICOL,JCOL,IDIR
 9054 FORMAT('ICOL,JCOL,IDIR = ',A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)ITYPE
 9055 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9069)IBUGG4,ISUBG4,IERRG4
 9069 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRTM(PXMIN,PYMIN,PXMAX,PYMAX,
     1ICASPL,ICAS3D,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1PX1COO,PX2COO,PY1COO,PY2COO,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1PX1CMN,PX2CMN,PY1CMN,PY2CMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
     1PTICTH,PMNTFA,
     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
     1IX1TCO,IX2TCO,IY1TCO,IY2TCO)
C
C     PURPOSE--DRAW TIC MARKS ON THE FRAME LINES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --FEBRUARY  1988.  STAR PLOT
C     UPDATED         --JANUARY   1989.  CALL DPDRPL RATHER THAN GRDRPL (ALAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 IX1FSW
      CHARACTER*4 IX2FSW
      CHARACTER*4 IY1FSW
      CHARACTER*4 IY2FSW
C
      CHARACTER*4 IX1TSW
      CHARACTER*4 IX2TSW
      CHARACTER*4 IY1TSW
      CHARACTER*4 IY2TSW
C
      CHARACTER*4 IX1TJU
      CHARACTER*4 IX2TJU
      CHARACTER*4 IY1TJU
      CHARACTER*4 IY2TJU
C
      CHARACTER*4 IX1TCO
      CHARACTER*4 IX2TCO
      CHARACTER*4 IY1TCO
      CHARACTER*4 IY2TCO
C
      CHARACTER*4 ITYPE
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 IFLAG
C
      DIMENSION PX1COO(*)
      DIMENSION PX2COO(*)
      DIMENSION PY1COO(*)
      DIMENSION PY2COO(*)
C
      DIMENSION PX1CMN(*)
      DIMENSION PX2CMN(*)
      DIMENSION PY1CMN(*)
      DIMENSION PY2CMN(*)
C
      DIMENSION PX(100)
      DIMENSION PY(100)
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.'DRTM')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRTM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)PXMIN,PYMIN,PXMAX,PYMAX
   52 FORMAT('PXMIN,PYMIN,PXMAX,PYMAX = ',4F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IX1FSW,IX2FSW,IY1FSW,IY2FSW
   54 FORMAT('IX1FSW,IX2FSW,IY1FSW,IY2FSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IX1TSW,IX2TSW,IY1TSW,IY2TSW
   55 FORMAT('IX1TSW,IX2TSW,IY1TSW,IY2TSW = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PTICTH,PMNTFA
   56 FORMAT('PTICTH,PMNTFA = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IX1TJU,IX2TJU,IY1TJU,IY2TJU
   57 FORMAT('IX1TJU,IX2TJU,IY1TJU,IY2TJU = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)IX1TCO,IX2TCO,IY1TCO,IY2TCO
   58 FORMAT('IX1TCO,IX2TCO,IY1TCO,IY2TCO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)NX1COO,NX2COO,NY1COO,NY2COO
   59 FORMAT('NX1COO,NX2COO,NY1COO,NY2COO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NX1CMN,NX2CMN,NY1CMN,NY2CMN
   60 FORMAT('NX1CMN,NX2CMN,NY1CMN,NY2CMN = ',4I8)
      CALL DPWRST('XXX','BUG ')
C
      IF(NX1COO.LE.0)GOTO69
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO61I=1,NX1COO
      WRITE(ICOUT,62)I,PX1COO(I),PX1CMN(I)
   62 FORMAT('I,PX1COO(I),PX1CMN(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
C
      IF(NX2COO.LE.0)GOTO79
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO71I=1,NX2COO
      WRITE(ICOUT,72)I,PX2COO(I),PX2CMN(I)
   72 FORMAT('I,PX2COO(I),PX2CMN(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
   79 CONTINUE
C
      IF(NY1COO.LE.0)GOTO89
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NY1COO
      WRITE(ICOUT,82)I,PY1COO(I),PY1CMN(I)
   82 FORMAT('I,PY1COO(I),PY1CMN(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   89 CONTINUE
C
      IF(NY2COO.LE.0)GOTO99
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO91I=1,NY2COO
      WRITE(ICOUT,92)I,PY2COO(I),PY2CMN(I)
   92 FORMAT('I,PY2COO(I),PY2CMN(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   91 CONTINUE
   99 CONTINUE
C
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
   90 CONTINUE
C
      IF(ICASPL.EQ.'PIEC')GOTO9000
      IF(ICASPL.EQ.'STAR')GOTO9000
      IF(ICAS3D.EQ.'ON')GOTO9000
C
      ITYPE='LINE'
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  THE TIC MARKS WILL HAVE SOLID LINE PATTERN.  **
C               **  TRANSLATE THIS SOLID LINE PATTERN            **
C               **  INTO A NUMBER WHICH CAN BE UNDERSTOOD        **
C               **  BY THE GRAPHICS DEVICE.                      **
C               ***************************************************
C
      IFIG='LINE'
      IPATT='SOLI'
      CALL GRTRPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************
C               **  STEP 2--                    **
C               **  SET THE LINE TYPE TO SOLID  **
C               **  ON THE GRAPHICS DEVICE.     **
C               **********************************
C
      CALL GRSEPA(ITYPE,IPATT,PXSPA,PYSPA,
     1JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TRANSLATE THE CHARACTER REPRESENTATION  **
C               **  OF THE TIC  THICKNESS                   **
C               **  INTO A NUMERIC REPRESENTATION           **
C               **  WHICH CAN BE UNDERSTOOD BY THE          **
C               **  GRAPHICS DEVICE.                        **
C               **********************************************
C
      PTHICK=PTICTH
      CALL GRTRTH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               *******************************
C               **  STEP 4--                 **
C               **  SET THE LINE THICKNESS   **
C               **  ON THE GRAPHICS DEVICE.  **
C               *******************************
C
      CALL GRSETH(ITYPE,PTHICK,JTHICK,PTHIC2)
C
C               ******************************************************
C               **  STEP 7--                                        **
C               **  DRAW MAJOR TIC MARKS ON BOTTOM HORIZONTAL AXIS  **
C               **  DRAW MINOR TIC MARKS ON BOTTOM HORIZONTAL AXIS  **
C               ******************************************************
C
      IF(IX1FSW.EQ.'OFF')GOTO1190
      IF(IX1TSW.EQ.'OFF')GOTO1190
C
      ICOL=IX1TCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PMJTLE=PX1TLE
C
      PY(1)=PYMIN
      PY(2)=PYMIN
      IF(IX1TJU.EQ.'THRU')PY(1)=PYMIN+PMJTLE/2.0
      IF(IX1TJU.EQ.'THRU')PY(2)=PYMIN-PMJTLE/2.0
      IF(IX1TJU.EQ.'IN')PY(1)=PYMIN+PMJTLE
      IF(IX1TJU.EQ.'INSI')PY(1)=PYMIN+PMJTLE
      IF(IX1TJU.EQ.'OUT')PY(1)=PYMIN-PMJTLE
      IF(IX1TJU.EQ.'OUTS')PY(1)=PYMIN-PMJTLE
C
      IF(NX1COO.LE.0)GOTO1190
      NP=2
      IFLAG='OFF'
      DO1110I=1,NX1COO
      PX(1)=PX1COO(I)
      PX(2)=PX1COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1110 CONTINUE
C
      PMNTLE=PMJTLE*PMNTFA
C
      PY(1)=PYMIN
      PY(2)=PYMIN
      IF(IX1TJU.EQ.'THRU')PY(1)=PYMIN+PMNTLE/2.0
      IF(IX1TJU.EQ.'THRU')PY(2)=PYMIN-PMNTLE/2.0
      IF(IX1TJU.EQ.'IN')PY(1)=PYMIN+PMNTLE
      IF(IX1TJU.EQ.'INSI')PY(1)=PYMIN+PMNTLE
      IF(IX1TJU.EQ.'OUT')PY(1)=PYMIN-PMNTLE
      IF(IX1TJU.EQ.'OUTS')PY(1)=PYMIN-PMNTLE
C
      IF(NX1CMN.LE.0)GOTO1190
      NP=2
      IFLAG='OFF'
      DO1120I=1,NX1CMN
      PX(1)=PX1CMN(I)
      PX(2)=PX1CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1120 CONTINUE
C
 1190 CONTINUE
C
C               ******************************************************
C               **  STEP 8--                                        **
C               **  DRAW MAJOR TIC MARKS ON TOP    HORIZONTAL AXIS  **
C               **  DRAW MINOR TIC MARKS ON TOP    HORIZONTAL AXIS  **
C               ******************************************************
C
      IF(IX2FSW.EQ.'OFF')GOTO1290
      IF(IX2TSW.EQ.'OFF')GOTO1290
C
      ICOL=IX2TCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PMJTLE=PX2TLE
C
      PY(1)=PYMAX
      PY(2)=PYMAX
      IF(IX2TJU.EQ.'THRU')PY(1)=PYMAX+PMJTLE/2.0
      IF(IX2TJU.EQ.'THRU')PY(2)=PYMAX-PMJTLE/2.0
      IF(IX2TJU.EQ.'IN')PY(1)=PYMAX-PMJTLE
      IF(IX2TJU.EQ.'INSI')PY(1)=PYMAX-PMJTLE
      IF(IX2TJU.EQ.'OUT')PY(1)=PYMAX+PMJTLE
      IF(IX2TJU.EQ.'OUTS')PY(1)=PYMAX+PMJTLE
C
      IF(NX2COO.LE.0)GOTO1290
      NP=2
      IFLAG='OFF'
      DO1210I=1,NX2COO
      PX(1)=PX2COO(I)
      PX(2)=PX2COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1210 CONTINUE
C
      PMNTLE=PMJTLE*PMNTFA
C
      PY(1)=PYMAX
      PY(2)=PYMAX
      IF(IX2TJU.EQ.'THRU')PY(1)=PYMAX+PMNTLE/2.0
      IF(IX2TJU.EQ.'THRU')PY(2)=PYMAX-PMNTLE/2.0
      IF(IX2TJU.EQ.'IN')PY(1)=PYMAX-PMNTLE
      IF(IX2TJU.EQ.'INSI')PY(1)=PYMAX-PMNTLE
      IF(IX2TJU.EQ.'OUT')PY(1)=PYMAX+PMNTLE
      IF(IX2TJU.EQ.'OUTS')PY(1)=PYMAX+PMNTLE
C
      IF(NX2CMN.LE.0)GOTO1290
      NP=2
      IFLAG='OFF'
      DO1220I=1,NX2CMN
      PX(1)=PX2CMN(I)
      PX(2)=PX2CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1220 CONTINUE
C
 1290 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  DRAW MAJOR TIC MARKS ON LEFT   VERTICAL   AXIS  **
C               **  DRAW MINOR TIC MARKS ON LEFT   VERTICAL   AXIS  **
C               ******************************************************
C
      IF(IY1FSW.EQ.'OFF')GOTO1390
      IF(IY1TSW.EQ.'OFF')GOTO1390
C
      ICOL=IY1TCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PMJTLE=PY1TLE*(ANUMVP/ANUMHP)
C
      PX(1)=PXMIN
      PX(2)=PXMIN
      IF(IY1TJU.EQ.'THRU')PX(1)=PXMIN-PMJTLE/2.0
      IF(IY1TJU.EQ.'THRU')PX(2)=PXMIN+PMJTLE/2.0
      IF(IY1TJU.EQ.'IN')PX(1)=PXMIN+PMJTLE
      IF(IY1TJU.EQ.'INSI')PX(1)=PXMIN+PMJTLE
      IF(IY1TJU.EQ.'OUT')PX(1)=PXMIN-PMJTLE
      IF(IY1TJU.EQ.'OUTS')PX(1)=PXMIN-PMJTLE
C
      IF(NY1COO.LE.0)GOTO1390
      NP=2
      IFLAG='OFF'
      DO1310I=1,NY1COO
      PY(1)=PY1COO(I)
      PY(2)=PY1COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1310 CONTINUE
C
      PMNTLE=PMJTLE*PMNTFA
C
      PX(1)=PXMIN
      PX(2)=PXMIN
      IF(IY1TJU.EQ.'THRU')PX(1)=PXMIN-PMNTLE/2.0
      IF(IY1TJU.EQ.'THRU')PX(2)=PXMIN+PMNTLE/2.0
      IF(IY1TJU.EQ.'IN')PX(1)=PXMIN+PMNTLE
      IF(IY1TJU.EQ.'INSI')PX(1)=PXMIN+PMNTLE
      IF(IY1TJU.EQ.'OUT')PX(1)=PXMIN-PMNTLE
      IF(IY1TJU.EQ.'OUTS')PX(1)=PXMIN-PMNTLE
C
      IF(NY1CMN.LE.0)GOTO1390
      NP=2
      IFLAG='OFF'
      DO1320I=1,NY1CMN
      PY(1)=PY1CMN(I)
      PY(2)=PY1CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1320 CONTINUE
C
 1390 CONTINUE
C
C               ******************************************************
C               **  STEP 10--                                       **
C               **  DRAW MAJOR TIC MARKS ON RIGHT  VERTICAL   AXIS  **
C               **  DRAW MINOR TIC MARKS ON RIGHT  VERTICAL   AXIS  **
C               ******************************************************
C
      IF(IY2FSW.EQ.'OFF')GOTO1490
      IF(IY2TSW.EQ.'OFF')GOTO1490
C
      ICOL=IY2TCO
      CALL GRTRCO(ITYPE,ICOL,JCOL)
      CALL GRSECO(ITYPE,ICOL,JCOL)
C
      PMJTLE=PY2TLE*(ANUMVP/ANUMHP)
C
      PX(1)=PXMAX
      PX(2)=PXMAX
      IF(IY2TJU.EQ.'THRU')PX(1)=PXMAX-PMJTLE/2.0
      IF(IY2TJU.EQ.'THRU')PX(2)=PXMAX+PMJTLE/2.0
      IF(IY2TJU.EQ.'IN')PX(1)=PXMAX-PMJTLE
      IF(IY2TJU.EQ.'INSI')PX(1)=PXMAX-PMJTLE
      IF(IY2TJU.EQ.'OUT')PX(1)=PXMAX+PMJTLE
      IF(IY2TJU.EQ.'OUTS')PX(1)=PXMAX+PMJTLE
C
      IF(NY2COO.LE.0)GOTO1490
      NP=2
      IFLAG='OFF'
      DO1410I=1,NY2COO
      PY(1)=PY2COO(I)
      PY(2)=PY2COO(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1410 CONTINUE
C
      PMNTLE=PMJTLE*PMNTFA
C
      PX(1)=PXMAX
      PX(2)=PXMAX
      IF(IY2TJU.EQ.'THRU')PX(1)=PXMAX-PMNTLE/2.0
      IF(IY2TJU.EQ.'THRU')PX(2)=PXMAX+PMNTLE/2.0
      IF(IY2TJU.EQ.'IN')PX(1)=PXMAX-PMNTLE
      IF(IY2TJU.EQ.'INSI')PX(1)=PXMAX-PMNTLE
      IF(IY2TJU.EQ.'OUT')PX(1)=PXMAX+PMNTLE
      IF(IY2TJU.EQ.'OUTS')PX(1)=PXMAX+PMNTLE
C
      IF(NY2CMN.LE.0)GOTO1490
      NP=2
      IFLAG='OFF'
      DO1420I=1,NY2CMN
      PY(1)=PY2CMN(I)
      PY(2)=PY2CMN(I)
CCCCC CALL GRDRPL(PX,PY,NP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
 1420 CONTINUE
C
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRTM')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRTM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PTICTH
 9016 FORMAT('PTICTH = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IFIG
 9018 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT,JPATT
 9019 FORMAT('IPATT,JPATT = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)PTHICK,JTHICK,PTHIC2
 9020 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICOL,JCOL
 9021 FORMAT('ICOL,JCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)ITYPE
 9022 FORMAT('ITYPE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDRTR(Y,X,PY,PX,NP,PY2,PX2,NP2,PY3,PX3,NP3,
     1ICASPL,ICAS3D,
     1ISORSW,
     1ILI2PA,ILI2CO,PLI2TH,
CCCCC OCTOBER 1993.  ADD ARE3BA
CCCCC1ARE2BA,
     1ARE2BA,ARE3BA,
     1IRE2FS,IRE2FC,
     1IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS,
CCCCC MARCH 1994.  ADD FOLLOWING LINE
     1IREBPL,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1IX1TSC,IY1TSC)
C
C     PURPOSE--FOR A GENERAL GRAPHICS DEVICE,
C              DRAW A SINGLE TRACE OF Y(.) VERSUS X(.)
C              FOR A SPECIFIED LINE TYPE, COLOR, AND THICKNESS.
C              AND (IF CALLED FOR) FILL IN BELOW/ABOVE THE TRACE
C              TO THE BASE LINE ARE2BA.
C     NOTE--THE VARIABLES PY(.) AND PX(.) ARE DUMMY VARIABLES
C           WHICH ARE USED IN THE INTERMEDIATE CALCULATIONS
C           AND WHOSE DIMENSIONS ARE DEFINED (FOR EASY OF CHANGE)
C           BACK IN THE MAIN ROUTINE.
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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --FEBRUARY 1988.   STAR PLOT
C     UPDATED         --JUNE     1988.   CALLS TO DPFIRE
C     UPDATED         --SEPTEMBER 1988.  LOG/WEIBULL CHECK AS A SUBROUTINE
C     UPDATED         --SEPTEMBER 1988.  RENUMBER
C     UPDATED         --DECEMBER  1988.  IBUGG4 FOR IBUGPL
C     UPDATED         --JUNE      1990.  NORMAL PLOT
C     UPDATED         --OCTOBER   1993.  BAR BASE AUTOMATIC
C     UPDATED         --OCTOBER   1993.  REGION BASE AUTOMATIC
C     UPDATED         --NOVEMBER  1993.  FILL PIE CHART AS "POLYGON"
C     UPDATED         --MARCH     1994   REGION BASE POLYGON
C     UPDATED         --DECEMBER  1996   FIX NORMAL PLOT
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAS3D
C
      CHARACTER*4 ISORSW
C
      CHARACTER*4 ILI2PA
      CHARACTER*4 ILI2CO
C
      CHARACTER*4 IRE2FS
      CHARACTER*4 IRE2FC
      CHARACTER*4 IRE2PT
      CHARACTER*4 IRE2PL
      CHARACTER*4 IRE2PC
      CHARACTER*4 IREBPL
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IY1TSC
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT
      CHARACTER*4 ICOL
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
C
      CHARACTER*4 ICASAX
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION PY(*)
      DIMENSION PX(*)
      DIMENSION PY2(*)
      DIMENSION PX2(*)
      DIMENSION PY3(*)
      DIMENSION PX3(*)
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
      HOLD=1.0
      ABASE=0.0
      PBASE=0.0
      PBASE2=0.0
      PLEFT=0.0
      PRIGHT=0.0
      AWIDTH=0.0
      PWIDTH=0.0
      FYRATI=0.0
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      FYMIN=FY1MIN
      FYMAX=FY1MAX
C
      AHUNDR=100.0
      ABASE2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRTR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDRTR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NP
   52 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,ICAS3D
   53 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO69
      DO65I=1,3
      WRITE(ICOUT,66)I,X(I),Y(I)
   66 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      NPM2=NP-2
      DO67I=NPM2,NP
      WRITE(ICOUT,68)I,X(I),Y(I)
   68 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   67 CONTINUE
   69 CONTINUE
      WRITE(ICOUT,70)ISORSW
   70 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)ILI2PA,ILI2CO,PLI2TH
   71 FORMAT('ILI2PA,ILI2CO,PLI2TH = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ARE2BA
   72 FORMAT('ARE2BA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IRE2FS,IRE2FC
   73 FORMAT('IRE2FS,IRE2FC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
   74 FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PXMIN,PXMAX,PYMIN,PYMAX
   84 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)FX1MIN,FX1MAX,FY1MIN,FY1MAX
   85 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IX1TSC,IY1TSC
   86 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGG4,ISUBG4,IERRG4
   89 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************************
C               **  STEP 1--                                   **
C               **  IF CALLED FOR, SORT THE DATA               **
C               **  ACCORDING TO THE HORIZONTAL AXIS VARIABLE  **
C               *************************************************
C
      IF(ISORSW.EQ.'OFF')GOTO1150
      IF(ICASPL.EQ.'PIEC')GOTO1150
      IF(ICASPL.EQ.'STAR')GOTO1150
      IF(ICAS3D.EQ.'ON')GOTO1150
      IF(ICASPL.EQ.'CONT')GOTO1150
CCCCC MARCH 1994.  ADD FOLLOWING LINE
      IF(IREBPL.EQ.'ON')GOTO1150
C
      CALL SORTC2(X,Y,NP,PX,PY)
      GOTO1190
C
 1150 CONTINUE
      DO1160I=1,NP
      PX(I)=X(I)
      PY(I)=Y(I)
 1160 CONTINUE
      GOTO1190
C
 1190 CONTINUE
C
C               **********************************************************
C               **  STEP 21--                                           **
C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS            **
C               **  ARE IN VALID RANGE.                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
C               **  CHECK THAT ALL   HORIZ.  AXIS DATA POINTS ARE > 0.  **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
C               **  CHECK THAT ALL   HORIZ. AXIS DATA POINTS ARE        **
C               **  STRICTLY > 0 AND STRICTLY < 100                     **
C               **********************************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO2110
      GOTO2119
 2110 CONTINUE
      ICASAX='2DHO'
      CALL CKLOSC(PX,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2119 CONTINUE
C
      IF(IX1TSC.EQ.'WEIB')GOTO2120
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990
      IF(IX1TSC.EQ.'NORM')GOTO2120
      GOTO2129
 2120 CONTINUE
      ICASAX='2DHO'
CCCCC CALL CKPRSC(PX,NP,ISORSW,ICASAX,
CCCCC1ISUBG4,IBUGG4,IERRG4)
CCCCC IF(IERRG4.EQ.'YES')GOTO9000
 2129 CONTINUE
C
C               **********************************************************
C               **  STEP 22--                                           **
C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,           **
C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS            **
C               **  ARE IN VALID RANGE.                                 **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,                  **
C               **  CHECK THAT ALL   VERT.   AXIS DATA POINTS ARE > 0.  **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,              **
C               **  CHECK THAT ALL   VERT.  AXIS DATA POINTS ARE        **
C               **  STRICTLY > 0 AND STRICTLY < 100                     **
C               **********************************************************
C
      IF(IY1TSC.EQ.'LOG')GOTO2210
      GOTO2219
 2210 CONTINUE
      ICASAX='2DVE'
      CALL CKLOSC(PY,NP,ISORSW,ICASAX,
     1ISUBG4,IBUGG4,IERRG4)
      IF(IERRG4.EQ.'YES')GOTO9000
 2219 CONTINUE
C
      IF(IY1TSC.EQ.'WEIB')GOTO2220
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1990
      IF(IY1TSC.EQ.'NORM')GOTO2220
      GOTO2229
 2220 CONTINUE
      ICASAX='2DVE'
CCCCC CALL CKPRSC(PY,NP,ISORSW,ICASAX,
CCCCC1ISUBG4,IBUGG4,IERRG4)
CCCCC IF(IERRG4.EQ.'YES')GOTO9000
 2229 CONTINUE
C
C               ******************************************
C               **  STEP 4--                            **
C               **  IF A NON-LINEAR SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
C               ******************************************
C               **  STEP 4.1--                          **
C               **  IF A LOG SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'LOG')GOTO4110
      GOTO4140
 4110 CONTINUE
      DO4115I=1,NP
      PX(I)=ALOG10(PX(I))
 4115 CONTINUE
 4140 CONTINUE
C
      ABASE=ARE2BA
CCCCC OCTOBER 1993.  ADD FOLLOWING
      ABAS2=ARE3BA
      IF(IY1TSC.EQ.'LOG')GOTO4160
      GOTO4190
 4160 CONTINUE
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0)ABASE=ALOG10(ABASE)
      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE=1.0
CCCCC OCTOBER 1993.  ADD FOLLOWING
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0)ABAS2=ALOG10(ABAS2)
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABAS2=1.0
      DO4165I=1,NP
      PY(I)=ALOG10(PY(I))
 4165 CONTINUE
 4190 CONTINUE
C
C               ******************************************
C               **  STEP 4.2--                          **
C               **  IF A WEIBULL SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'WEIB')GOTO4210
      GOTO4240
 4210 CONTINUE
      DO4215I=1,NP
      PX(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PX(I))))
 4215 CONTINUE
 4240 CONTINUE
C
      ABASE=ARE2BA
CCCCC OCTOBER 1993.  ADD FOLLOWING
      ABAS2=ARE3BA
      IF(IY1TSC.EQ.'WEIB')GOTO4260
      GOTO4290
 4260 CONTINUE
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
     1ABASE2=ALOG(ALOG(AHUNDR/(AHUNDR-ABASE)))
      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
      IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
      ABASE=ABASE2
CCCCC OCTOBER 1993.  ADD FOLLOWING
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0.AND.ABAS2.LT.AHUNDR)
     1ABASE2=ALOG(ALOG(AHUNDR/(AHUNDR-ABAS2)))
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABASE2=0.1
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GE.AHUNDR)ABASE2=0.1
      ABAS2=ABASE2
      DO4265I=1,NP
      PY(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PY(I))))
 4265 CONTINUE
 4290 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1990
C               ******************************************
C               **  STEP 4.3--                          **
C               **  IF A NORMAL SCALE PLOT IS CALLED FOR,  **
C               **  TRANSFORM THE DATA                  **
C               ******************************************
C
      IF(IX1TSC.EQ.'NORM')GOTO4310
      GOTO4340
 4310 CONTINUE
      DO4315I=1,NP
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT JULY 1993
CCCCC THE FOLLOWING 2 LINES WERE UN-COMMENTED OUT DECEMBER 1996
      ARG=PX(I)/AHUNDR
      CALL NORPPF(ARG,PX(I))
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT DECEMBER 1996
CCCCC CALL NORCDF(PX(I),PX(I))
CCCCC PX(I)=AHUNDR*PX(I)
 4315 CONTINUE
 4340 CONTINUE
C
      ABASE=ARE2BA
CCCCC OCTOBER 1993.  ADD FOLLOWING
      ABAS2=ARE3BA
      IF(IY1TSC.EQ.'NORM')GOTO4360
      GOTO4390
 4360 CONTINUE
CCCCC IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
CCCCC1ABASE2=ALOG(ALOG(AHUNDR/(AHUNDR-ABASE)))
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
     1ARG=ABASE/AHUNDR
      IF(ABASE.NE.CPUMAX.AND.ABASE.GT.0.0.AND.ABASE.LT.AHUNDR)
     1CALL NORPPF(ARG,ABASE2)
      IF(ABASE.NE.CPUMAX.AND.ABASE.LE.0.0)ABASE2=0.1
      IF(ABASE.NE.CPUMAX.AND.ABASE.GE.AHUNDR)ABASE2=0.1
      ABASE=ABASE2
CCCCC OCTOBER 1993.  ADD FOLLOWING
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0.AND.ABAS2.LT.AHUNDR)
     1ARG=ABAS2/AHUNDR
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GT.0.0.AND.ABAS2.LT.AHUNDR)
     1CALL NORPPF(ARG,ABASE2)
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.LE.0.0)ABASE2=0.1
      IF(ABAS2.NE.CPUMAX.AND.ABAS2.GE.AHUNDR)ABASE2=0.1
      ABAS2=ABASE2
      DO4365I=1,NP
CCCCC PY(I)=ALOG(ALOG(AHUNDR/(AHUNDR-PY(I))))
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT JULY 1993
CCCCC THE FOLLOWING 2 LINES WERE UN-COMMENTED OUT DECEMBER 1996
      ARG=PY(I)/AHUNDR
      CALL NORPPF(ARG,PY(I))
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT DECEMBER 1996
CCCCC CALL NORCDF(PY(I),PY(I))
CCCCC PY(I)=AHUNDR*PY(I)
 4365 CONTINUE
 4390 CONTINUE
C
C               *****************************************************
C               **  STEP 5--                                       **
C               **  TRANSLATE THE DATA POINTS                      **
C               **  INTO STANDARDIZED (0.0 TO 100.0) COORDINATES.  **
C               *****************************************************
C
      FXMIN=FX1MIN
      FXMAX=FX1MAX
      IF(IX1TSC.EQ.'LOG')FXMIN=ALOG10(FX1MIN)
      IF(IX1TSC.EQ.'LOG')FXMAX=ALOG10(FX1MAX)
      IF(IX1TSC.EQ.'WEIB')FXMIN=ALOG(ALOG(AHUNDR/(AHUNDR-FX1MIN)))
      IF(IX1TSC.EQ.'WEIB')FXMAX=ALOG(ALOG(AHUNDR/(AHUNDR-FX1MAX)))
CCCCC THE FOLLOWING SECTION WAS REWRITTEN DECEMBER 1996
      IF(IX1TSC.EQ.'NORM')THEN
         ARG=FX1MIN/AHUNDR
         CALL NORPPF(ARG,FXMIN)
         ARG=FX1MAX/AHUNDR
         CALL NORPPF(ARG,FXMAX)
      END IF
C
      FYMIN=FY1MIN
      FYMAX=FY1MAX
      IF(IY1TSC.EQ.'LOG')FYMIN=ALOG10(FY1MIN)
      IF(IY1TSC.EQ.'LOG')FYMAX=ALOG10(FY1MAX)
      IF(IY1TSC.EQ.'WEIB')FYMIN=ALOG(ALOG(AHUNDR/(AHUNDR-FY1MIN)))
      IF(IY1TSC.EQ.'WEIB')FYMAX=ALOG(ALOG(AHUNDR/(AHUNDR-FY1MAX)))
CCCCC THE FOLLOWING SECTION WAS REWRITTEN DECEMBER 1996
      IF(IY1TSC.EQ.'NORM')THEN
         ARG=FY1MIN/AHUNDR
         CALL NORPPF(ARG,FYMIN)
         ARG=FY1MAX/AHUNDR
         CALL NORPPF(ARG,FYMAX)
      ENDIF
CCCCC THE FOLLOWING 6 LINES WERE COMMENTED OUT DECEMBER 1996
CCCCC IF(IY1TSC.EQ.'NORM')THEN
CCCCC    CALL NORCDF(FY1MIN,FYMIN)
CCCCC    FYMIN=AHUNDR*FYMIN
CCCCC    CALL NORCDF(FY1MAX,FYMAX)
CCCCC    FYMAX=AHUNDR*FYMAX
CCCCC ENDIF
C
      FXRANG=FXMAX-FXMIN
      FYRANG=FYMAX-FYMIN
      PXRANG=PXMAX-PXMIN
      PYRANG=PYMAX-PYMIN
C
      DO5100I=1,NP
      FXRATI=(PX(I)-FXMIN)/FXRANG
      FYRATI=(PY(I)-FYMIN)/FYRANG
      PX(I)=PXMIN+FXRATI*PXRANG
      PY(I)=PYMIN+FYRATI*PYRANG
 5100 CONTINUE
      IF(ABASE.NE.CPUMAX)FYRATI=(ABASE-FYMIN)/FYRANG
      IF(ABASE.NE.CPUMAX)PBASE=PYMIN+FYRATI*PYRANG
CCCCC OCTOBER 1993.  ADD FOLLOWING
      IF(ABAS2.NE.CPUMAX)FYRAT2=(ABAS2-FYMIN)/FYRANG
      IF(ABAS2.NE.CPUMAX)PBASE9=PYMIN+FYRAT2*PYRANG
C
C               **************************************
C               **  STEP 6--                        **
C               **  IF CALLED FOR,                  **
C               **  FILL OVER/UNDER THE TRACE       **
C               **  (BUT CLIP FIRST, IF NECESSARY)  **
C               **************************************
C
      IFIG='GENE'
      IF(ICASPL.EQ.'PIEC')IFIG='POLY'
CCCCC MARCH 1994.  ADD FOLLOWING LINE
      IF(IREBPL.EQ.'ON')IFIG='POLY'
C
      IF(IRE2FS.EQ.'OFF')GOTO6190
      IPATT=IRE2PT
      PTHICK=PRE2PT
      PXGAP=PRE2PS
      PYGAP=PRE2PS
      ICOLF=IRE2FC
      ICOLP=IRE2PC
C
      CALL DPSQUE(PX,PY,NP,
     1PXMIN,PXMAX,PYMIN,PYMAX)
C
CCCCC MARCH 1994.  ADD FOLLOWING LINE
      IF(IREBPL.EQ.'ON')GOTO6110
      IF(ABASE.EQ.CPUMAX)GOTO6110
      GOTO6120
C
 6110 CONTINUE
      DO6115I=1,NP
      PX2(I)=PX(I)
      PY2(I)=PY(I)
 6115 CONTINUE
      NP2=NP+1
      PX2(NP2)=PX(1)
      PY2(NP2)=PY(1)
C
      DO6116J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 6116 CONTINUE
C
CCCCC CALL DPFIRE(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
C JUNE, 1988
      IPATT2=IRE2PL
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      GOTO6190
C
 6120 CONTINUE
      PBASE2=PBASE
      IF(PBASE2.LT.PYMIN.AND.(PYMIN-PBASE2).LE.0.0001)PBASE2=PYMIN
      IF(PBASE2.GT.PYMAX.AND.(PBASE2-PYMAX).LE.0.0001)PBASE2=PYMAX
CCCCC OCTOBER 1993.  ADD FOLLOWING
      PBASE8=PBASE9
      IF(PBASE9.LT.PYMIN.AND.(PYMIN-PBASE9).LE.0.0001)PBASE8=PYMIN
      IF(PBASE9.GT.PYMAX.AND.(PBASE9-PYMAX).LE.0.0001)PBASE8=PYMAX
CCCCC OCTOBER 1993.
      IF(NP.GT.2)GOTO6130
C
      NP2=5
      NPM1=NP-1
      IF(NPM1.LE.0)GOTO6190
      DO6125I=1,NPM1
      IP1=I+1
C
      PLEFT=PX(I)
      PRIGHT=PX(IP1)
      IF(PLEFT.LT.PXMIN.AND.(PXMIN-PLEFT).LE.0.0001)PLEFT=PXMIN
      IF(PRIGHT.GT.PXMAX.AND.(PRIGHT-PXMAX).LE.0.0001)PRIGHT=PXMAX
C
      IF(PRIGHT.LT.PXMIN)GOTO6125
      IF(PLEFT.GT.PXMAX)GOTO6125
      IF(PY(I).LT.PYMIN.AND.PBASE2.LT.PYMIN)GOTO6125
      IF(PY(I).GT.PYMAX.AND.PBASE2.GT.PYMAX)GOTO6125
C
      PX2(1)=PLEFT
      PX2(2)=PRIGHT
      PX2(3)=PRIGHT
      PX2(4)=PLEFT
      PX2(5)=PLEFT
C
      PY2(1)=PBASE2
CCCCC OCTOBER 1993.  ADD FOLLOWING
CCCCC PY2(2)=PBASE2
      PY2(2)=PBASE8
CCCCC END CHANGE
      PY2(3)=PY(IP1)
      PY2(4)=PY(I)
      PY2(5)=PBASE2
C
      DO6126J=1,NP2
      IF(PX2(J).LT.PXMIN)PX2(J)=PXMIN
      IF(PX2(J).GT.PXMAX)PX2(J)=PXMAX
      IF(PY2(J).LT.PYMIN)PY2(J)=PYMIN
      IF(PY2(J).GT.PYMAX)PY2(J)=PYMAX
 6126 CONTINUE
C
CCCCC CALL DPFIRE(PX2,PY2,NP2,
CCCCC1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP)
CCCCC JUNE, 1988.
      IPATT2=IRE2PL
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 6125 CONTINUE
C
      GOTO6190
CCCCC OCTOBER 1993.  TREAT REGION AS SINGLE POLYGON
 6130 CONTINUE
C
      DO6135I=1,NP
C
      PX2(I)=PX(I)
      PY2(I)=PY(I)
      IF(PX2(I).LT.PXMIN)PX2(I)=PXMIN
      IF(PX2(I).GT.PXMAX)PX2(I)=PXMAX
      IF(PY2(I).LT.PYMIN)PY2(I)=PYMIN
      IF(PY2(I).GT.PYMAX)PY2(I)=PYMAX
 6135 CONTINUE
C
      NP2=NP+1
      PX2(NP2)=PX2(NP)
      PY2(NP2)=PBASE2
      NP2=NP2+1
      PX2(NP2)=PX2(1)
      PY2(NP2)=PBASE2
      NP2=NP2+1
      PX2(NP2)=PX2(1)
      PY2(NP2)=PY2(1)
C
      IPATT2=IRE2PL
      CALL DPFIRE(PX2,PY2,NP2,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
C
      GOTO6190
C
 6190 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  DRAW OUT THE TRACE                 **
C               **  (BUT CLIP IT FIRST, IF NECESSARY)  **
C               *****************************************
C
      IFIG='GENE'
      IPATT=ILI2PA
      PTHICK=PLI2TH
      ICOL=ILI2CO
C
      CALL DPCLTR(PX,PY,NP,PX2,PY2,NP2,PY3,PX3,NP3,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1ISORSW,
     1IFIG,IPATT,PTHICK,ICOL)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRTR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDRTR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NP
 9012 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,ICAS3D
 9013 FORMAT('ICASPL,ICAS3D = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NP.LE.3)GOTO9029
      DO9025I=1,3
      WRITE(ICOUT,9026)I,X(I),Y(I)
 9026 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      NPM2=NP-2
      DO9027I=NPM2,NP
      WRITE(ICOUT,9028)I,X(I),Y(I)
 9028 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9027 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9030)ISORSW
 9030 FORMAT('ISORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)ILI2PA,ILI2CO,PLI2TH
 9031 FORMAT('ILI2PA,ILI2CO,PLI2TH = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)ARE2BA
 9032 FORMAT('ARE2BA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)IRE2FS,IRE2FC
 9033 FORMAT('IRE2FS,IRE2FC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS
 9034 FORMAT('IRE2PT,IRE2PL,IRE2PC,PRE2PT,PRE2PS = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PXMIN,PXMAX,PYMIN,PYMAX
 9044 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)FX1MIN,FX1MAX,FY1MIN,FY1MAX
 9045 FORMAT('FX1MIN,FX1MAX,FY1MIN,FY1MAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)FXMIN,FXMAX,FYMIN,FYMAX
 9046 FORMAT('FXMIN,FXMAX,FYMIN,FYMAX= ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)IX1TSC,IY1TSC
 9047 FORMAT('IX1TSC,IY1TSC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDUAN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A DUANE PLOT
C              (USED IN RELIABILITY)
C              VERTICAL AXIS   = Ti /I
C              HORIZONTAL AXIS = Ti
C              WHERE Ti ARE SORTED FAILURE TIMES
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
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 ISUBRO
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IHVA21
CCCCC CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPDU'
      ISUBN2='AN  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DUAN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               **********************************
C               **  TREAT THE DUANE PLOT    **
C               **********************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  SEARCH FOR DUANE PLOT            **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='DUAN'
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DUAN'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASPL.EQ.'DUAN')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPDUAN')
      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 TO    DUAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,IWIDTH)
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     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 12--                                            **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPDUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IHLEFT,IHLEF2
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A DUANE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IS TO BE GENERATED)')
      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)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DUAN')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EXACTLY 1                               **
C               **  FOR A DUANE PLOT).                   **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO2209
      GOTO2250
C
 2209 CONTINUE
      IF(NUMV2.LE.1)GOTO2290
C
 2250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN DPDUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR A DUANE PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST BE EXACTLY 1  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)NUMV2
 2257 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)
 2258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2259)(IANS(I),I=1,IWIDTH)
 2259 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               **********************************************
C               **  STEP 31--                               **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE BY                   **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='31'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO3110
      IF(ICASQ.EQ.'SUBS')GOTO3120
      IF(ICASQ.EQ.'FOR')GOTO3130
C
 3110 CONTINUE
      DO3115I=1,NLEFT
      ISUB(I)=1
 3115 CONTINUE
      NQ=NLEFT
      GOTO3150
C
 3120 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3150
C
 3130 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3150
C
 3150 CONTINUE
      IF(NQ.GE.MINN2)GOTO3160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** ERROR IN DPDUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)
 3152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IHLEFT,IHLEF2
 3153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)
 3154 FORMAT('      (FOR WHICH AN AUTO OR CROSS-PERIODOGRAM ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3155)
 3155 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3156)MINN2
 3156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3157)
 3157 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3158)
 3158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3159)(IANS(I),I=1,IWIDTH)
 3159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3160 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3170
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1WRITE(ICOUT,3166)I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ)
 3166 FORMAT('I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ) = ',6I8,E15.7)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DUAN')
     1CALL DPWRST('XXX','BUG ')
      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)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOLL.EQ.MAXCP31)Y1(J)=TAGPLO(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
 3170 CONTINUE
      NS=J
C
C               *************************************************************
C               **  STEP 41--                                              **
C               **  FORM THE VERTICAL AND HORIZONTALAXIS                   **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE PLOT.   **
C               **  FORM THE CURVE DESIGNATION VARIABLED(.)  .             **
C               **  THIS WILL BE ALL ONES.                                 **
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.'DUAN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPDUA2(Y1,NS,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1IBUGG3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  COMPUTE DUANE PLOT STAT          **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ISUBN0='DPDU'
CCCCC CALL LINFIT(Y,X,NPLOTP,
CCCCC1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
CCCCC1ISUBRO,IBUGG3,IERROR)
C
      IH='DPCC'
      IH2='    '
      VALUE0=CCXY
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='DPA0'
      IH2='    '
      VALUE0=ALPHA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='DPA1'
      IH2='    '
      VALUE0=BETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDDP'
      IH2='A0  '
      VALUE0=SDALPH
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='SDDP'
      IH2='A1  '
      VALUE0=SDBETA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='DPRE'
      IH2='SSD '
      VALUE0=XRESSD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
      IH='DPRE'
      IH2='SDF '
      VALUE0=XRESDF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DUAN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDUAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      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 DPDUA2(Y1,N,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A DUANE PLOT
C              VERTICAL AXIS   = Ti/I
C              HORIZONTAL AXIS = Ti
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
C              (IT WILL BE SORTED)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
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='DPDU'
      ISUBN2='A2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'DUA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPDUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,ICASPL,MAXN
   53 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y1(I)
   56 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPDUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)N
  114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y1(1)
      DO120I=1,N
      IF(Y1(I).NE.HOLD)GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** ERROR IN DPDUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,123)HOLD
  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  129 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  COMPUTE COORDINATES FOR TAIL AREA PLOT   **
C               **  (INCORPORATE STAIR-STEP APPEARANCE)      **
C               **  NOTE--THE LOGGING OF THE 1-F(X) WILL     **
C               **        NOTE BE DONE HEREIN BUT WILL       **
C               **        BE DONE IN THE UNDERLYING          **
C               **        GRAPHICS BY LOG SCALE              **
C               ***********************************************
C
C
      CALL SORT(Y1,N,Y1)
C
      AN=N
      J=0
      DO1100I=1,N
      J=J+1
      X(J)=Y1(I)
      Y(J)=Y1(J)/REAL(J)
      D(J)=1.0
 1100 CONTINUE
      NPLOTP=J
C
C  NOTE: FOR FITTED LINE, NEED TO FIT THE LOGS OF Y AND X
C
      ISUBN0='DPDU'
      DO200I=1,NPLOTP
       Y(I)=LOG(Y(I))
       X(I)=LOG(X(I))
 200  CONTINUE 
      CALL LINFIT(Y,X,NPLOTP,
     1ALPHA,BETA,XRESSD,XRESDF,CCXY,SDALPH,SDBETA,CCALBE,
     1ISUBRO,IBUGG3,IERROR)
      DO300I=1,NPLOTP
       Y(I)=EXP(Y(I))
       X(I)=EXP(X(I))
 300  CONTINUE 
      NPLOTP=NPLOTP+1
      X(NPLOTP)=X(1)
      Y(NPLOTP)=EXP(ALPHA+BETA*LOG(X(1)))
      D(NPLOTP)=2.0
      NPLOTP=NPLOTP+1
      X(NPLOTP)=X(N)
      Y(NPLOTP)=EXP(ALPHA+BETA*LOG(X(N)))
      D(NPLOTP)=2.0
C
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'DUA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPDUA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,ICASPL,MAXN
 9013 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y1(I)
 9016 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NPLOTP,NPLOTV
 9021 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NPLOTP
      WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
 9023 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPDURB(YTEMP,XTEMP,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT DURBIN TEST
C              NON-PARAMETRIC TWO-WAY ANOVA OF INCOMPLETE BLOCK
C              DESIGNS
C     EXAMPLE--DURBIN TEST Y X1 X2
C     REFERENCE--W. J. CONOVER (1999).  "PRACTICAL NONPARAMETRIC
C                STATISTICS", THIRD EDITION, WILEY, PP. 388-395.
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--2006/1
C     ORIGINAL VERSION--JANUARY   2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
      CHARACTER*4 IUSE3
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP2(MAXOBV)
      DIMENSION DBLOCK(MAXOBV)
      DIMENSION DTREAT(MAXOBV)
      DIMENSION YRANK(MAXOBV)
      DIMENSION RJ(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE(GARBAG(IGARB1),XTEMP2(1))
      EQUIVALENCE(GARBAG(IGARB2),DBLOCK(1))
      EQUIVALENCE(GARBAG(IGARB3),DTREAT(1))
      EQUIVALENCE(GARBAG(IGARB4),YRANK(1))
      EQUIVALENCE(GARBAG(IGARB5),RJ(1))
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPDU'
      ISUBN2='RB  '
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=4
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ******************************************
C               **  TREAT THE DURBIN TEST CASE        **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPDURB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA2,IBUGA3,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUBQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)ICAPSW,ICAPTY
   53   FORMAT('ICAPSW,ICAPTY = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)MAXNXT
   55   FORMAT('MAXNXT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************************
C               **  STEP 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=3
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DURBIN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE DURBIN TEST, THE FIRST ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      RESPONSE VARIABLE) MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 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 4 OR MORE.                    **
C               ******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V' .AND. N1.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** ERROR IN DURBIN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)
 1212   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1214)
 1214   FORMAT('      DURBIN TEST WAS TO HAVE BEEN CARRIED OUT MUST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1216)MINN2
 1216   FORMAT('      BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1218)IH11,IH12,N1
 1218   FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1219)
 1219   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1220)(IANS(I),I=1,MIN(IWIDTH,80))
 1220     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN THE DURBIN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR THE DURBIN TEST, THE SECOND ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      FIRST FACTOR (= BLOCK) VARIABLE)  MUST BE A')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      FUNCTION).  ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,2150)(IANS(I),I=1,MIN(IWIDTH,80))
 2150      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
C
C               ******************************************************
C               **  STEP 21B--                                      **
C               **  IF ARGUMENT 2 IS A VARIABLE,                    **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)**
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.       **
C               ******************************************************
C
      ISTEPN='21B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.EQ.'V' .AND. N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2161)
 2161   FORMAT('***** ERROR IN THE DURBIN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2162)
 2162   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 2')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2163)
 2163   FORMAT('      OF THE DURBIN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2165)
 2165   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2166)N1,N2
 2166   FORMAT('      N1 = ',I8,' N2 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2169)
 2169   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2170)(IANS(I),I=1,MIN(IWIDTH,80))
 2170     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ****************************************
C               **  STEP 22--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2241)
 2241    FORMAT('***** ERROR IN THE DURBIN TEST--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2242)
 2242    FORMAT('      FOR THE DURBIN TEST, THE THIRD ARGUMENT (THE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2245)
 2245    FORMAT('      SECOND FACTOR (= TREATMENT) VARIABLE)  MUST BE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2246)
 2246    FORMAT('      A VARIABLE (AS OPPOSED TO A PARAMETER OR')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2247)
 2247    FORMAT('      FUNCTION).  ARGUMENT 3 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2248)
 2248    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)THEN
           WRITE(ICOUT,2250)(IANS(I),I=1,MIN(IWIDTH,80))
 2250      FORMAT(80A1)
           CALL DPWRST('XXX','BUG ')
         ENDIF
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE3=IUSE(ILOCV)
      ICOL3=IVALUE(ILOCV)
      N3=IN(ILOCV)
C
C               ******************************************************
C               **  STEP 21B--                                      **
C               **  IF ARGUMENT 3 IS A VARIABLE,                    **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N3)**
C               **  FOR ARGUMENT 3 IS THE SAME AS ARGUMENT 1.       **
C               ******************************************************
C
      ISTEPN='22B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE3.EQ.'V' .AND. N1.NE.N3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2261)
 2261   FORMAT('***** ERROR IN THE DURBIN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2262)
 2262   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR VARIABLE 3')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2263)
 2263   FORMAT('      OF THE DURBIN TEST MUST BE THE SAME AS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2265)
 2265   FORMAT('      VARIABLE 1.  SUCH WAS NOT THE CASE HERE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2266)N1,N3
 2266   FORMAT('      N1 = ',I8,' N3 = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2269)
 2269   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2270)(IANS(I),I=1,MIN(IWIDTH,80))
 2270     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE 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
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DURB')THEN
        WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.LE.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4151)
 4151   FORMAT('***** ERROR IN THE DURBIN TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4152)
 4152   FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN EXTRACTED,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4153)IH11,IH12
 4153   FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING FROM ',
     1         'VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4154)
 4154   FORMAT('      (FOR WHICH THE DURBIN TEST IS TO BE CARRIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4156)MINN2
 4156   FORMAT('      OUT) MUST BE ',I8,' OR LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4157)NQ
 4157   FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4158)
 4158   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,4159)(IANS(I),I=1,MIN(IWIDTH,80))
 4159     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO4170
        J=J+1
C
        IJ=MAXN*(ICOL1-1)+I
        IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
        IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
        IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
        IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
        IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
        IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
        IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
        IJ=MAXN*(ICOL2-1)+I
        IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
        IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
        IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
        IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
        IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
        IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
        IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
        IJ=MAXN*(ICOL3-1)+I
        IF(ICOL2.LE.MAXCOL)XTEMP2(J)=V(IJ)
        IF(ICOL2.EQ.MAXCP1)XTEMP2(J)=PRED(I)
        IF(ICOL2.EQ.MAXCP2)XTEMP2(J)=RES(I)
        IF(ICOL2.EQ.MAXCP3)XTEMP2(J)=YPLOT(I)
        IF(ICOL2.EQ.MAXCP4)XTEMP2(J)=XPLOT(I)
        IF(ICOL2.EQ.MAXCP5)XTEMP2(J)=X2PLOT(I)
        IF(ICOL2.EQ.MAXCP6)XTEMP2(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
C               **********************************
C               **  STEP 52--                   **
C               **  CARRY OUT THE DURBIN TEST   **
C               **********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DURB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5211)
 5211   FORMAT('***** FROM DPDURB, AS WE ARE ABOUT TO CALL DPDUR2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5212)N1,N2,N3,NS1,MAXN
 5212   FORMAT('N1,N2,N3,NS1,MAXN = ',5I8)
        CALL DPWRST('XXX','BUG ')
        DO5215I=1,NS1
         WRITE(ICOUT,5216)I,Y(I),X(I),XTEMP2(I)
 5216    FORMAT('I,Y(I),X(I),XTEMP2(I) = ',I8,3E15.7)
         CALL DPWRST('XXX','BUG ')
 5215   CONTINUE
        WRITE(ICOUT,5231)IBUGA3
 5231   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPDUR2(Y,X,XTEMP2,NS1,
     1YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'DURB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPFR'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF0 '
      VALUE0=CUT0
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF50'
      VALUE0=CUT50
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF75'
      VALUE0=CUT75
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F999'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPDURB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA2,IBUGA3,IBUGQ
 9012   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)N1,N2,N3,NS1
 9014   FORMAT('N1,N2,N3,NS1 = ',4I8)
        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 DPDUR2(Y,BLOCK,TREAT,N,
     1YTEMP,XTEMP,YRANK,RJ,DBLOCK,DTREAT,MAXNXT,
     1STATVA,STATCD,CUT0,CUT50,CUT75,CUT90,CUT95,CUT99,CUT999,
     1ICAPSW,ICAPTY,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT DURBIN'S TEST
C              NON-PARAMETRIC TWO-WAY ANOVA FOR BALANCED,
C              INCOMPLETE BLOCK DESIGNS
C     EXAMPLE--DURBIN TEST Y BLOCK TREAT
C     REFERENCE--W. J. CONOVER (1999).  "PRACTICAL NONPARAMETRIC
C                STATISTICS", THIRD EDITION, WILEY, PP. 388-395.
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--2006/1
C     ORIGINAL VERSION--JANUARY   2006.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*3 IATEMP
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION BLOCK(*)
      DIMENSION TREAT(*)
      DIMENSION YRANK(*)
      DIMENSION RJ(*)
      DIMENSION DBLOCK(*)
      DIMENSION DTREAT(*)
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
      INCLUDE 'DPCOF2.INC'
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
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='DPDU'
      ISUBN2='R2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPDUR2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
          WRITE(ICOUT,57)I,Y(I),BLOCK(I),TREAT(I)
   57     FORMAT('I,Y(I),BLOCK(I),TREAT(I) = ',I8,3E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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 DURBIN TEST--RESPONSE VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      HOLD=BLOCK(1)
      DO1235I=2,N
      IF(BLOCK(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DURBIN TEST--FIRST FACTOR VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
      HOLD=TREAT(1)
      DO1335I=2,N
      IF(TREAT(I).NE.HOLD)GOTO1339
 1335 CONTINUE
 1330 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1331)HOLD
 1331 FORMAT('***** NOTE FROM DURBIN TEST--SECOND FACTOR VARIABLE ',
     1       'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1339 CONTINUE
C
C               ********************************************
C               **  STEP 12--                             **
C               **  CHECK TO SEE IF A BALANCED DESIGN     **
C               **  WAS ENTERED.                          **
C               **  1) EVERY BLOCK CONTAINS K EXPERIMENTAL**
C               **     UNITS.                             **
C               **  2) EVERY TREATMENT APPEARS IN R       **
C               **     BLOCKS.                            **
C               ********************************************
C
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'DUR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  STEP 1: COMPUTE NUMBER OF DISTINCT BLOCKS AND TREATMENTS
C
      CALL DISTIN(BLOCK,N,IWRITE,DBLOCK,NBLOCK,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES' .OR. NBLOCK.LE.0)GOTO9000
      CALL DISTIN(TREAT,N,IWRITE,DTREAT,NTREAT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES' .OR. NTREAT.LE.0)GOTO9000
C
C  STEP 2: DETERMINE IF EVERY BLOCK CONTAINS K EXPERIMENTAL
C          TREATMENTS
C
      KHOLD=0
      DO1410I=1,NBLOCK
        ABLOCK=BLOCK(I)
        NK=0
        DO1420J=1,N
          IF(BLOCK(J).EQ.ABLOCK)NK=NK+1
 1420   CONTINUE
        IF(KHOLD.EQ.0)THEN
          KHOLD=NK
        ELSE
          IF(NK.NE.KHOLD)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1431)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1432)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1433)I,NK,KHOLD
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 1410 CONTINUE
 1431 FORMAT('***** ERROR FROM DURBIN TEST--')
 1432 FORMAT('      UNEQUAL BLOCK SIZES DETECTED:')
 1433 FORMAT('      BLOCK ',I8,' HAD ',I8,' TREATMENTS WHEN ',
     1       I8,' TREATMENTS WERE EXPECTED.')
C
C  STEP 3: DETERMINE IF EVERY TREATMENT APPEARS IN R BLOCKS
C          (FOR NOW JUST CHECK THAT IT APPEARS R TIMES)
C
      IRHOLD=0
      DO1510I=1,NTREAT
        ATREAT=TREAT(I)
        NR=0
        DO1520J=1,N
          IF(TREAT(J).EQ.ATREAT)NR=NR+1
 1520   CONTINUE
        IF(IRHOLD.EQ.0)THEN
          IRHOLD=NR
        ELSE
          IF(NR.NE.IRHOLD)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1531)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1532)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,1533)I,NR,IRHOLD
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ENDIF
        ENDIF
 1510 CONTINUE
 1531 FORMAT('***** ERROR FROM DURBIN TEST--')
 1532 FORMAT('      UNEQUAL TREATMENT SIZES DETECTED:')
 1533 FORMAT('      TREATMENT ',I8,' APPEARED ',I8,' TIMES ',
     1       'WHEN ',I8,' OCCURENCES WERE EXPECTED.')
C
C               ******************************
C               **  STEP 21--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR DURBIN TEST         **
C               ******************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
C  COMPUTATIONAL ALGORITHM:
C
C  1. X(IJ)     = RESPONSE FOR BLOCK I, TREATMENT J
C  2. R(X(IJ))  = RANK OF X(IJ) WITHIN EACH BLOCK
C  3. R(J)      = SUM[I=1 TO K][R(X(IJ))]
C  4. A         = SUM[I=1 TO B][J=1 TO T][(R(X(IJ)]**2
C  5. C         = B*K(K+1)**2/4
C  6. T1        = (T-1)*{SUM[J=1 TO T][R(J)**2] - R*C]/(A-C)
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO4010I=1,MAXNXT
        XTEMP(I)=0.0
        YTEMP(I)=0.0
        YRANK(I)=0.0
        RJ(I)=0.0
 4010 CONTINUE
C
C  EXTRACT THE X(IJ) FOR EACH BLOCK
C
      DO2110I=1,NBLOCK
        HOLD=DBLOCK(I)
        ICOUNT=0
        DO2120J=1,N
          IF(BLOCK(J).EQ.HOLD)THEN
            ICOUNT=ICOUNT+1
            YTEMP(ICOUNT)=Y(J)
          ENDIF
 2120   CONTINUE
        CALL RANK(YTEMP,ICOUNT,IWRITE,XTEMP,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOUNT=0
        DO2130J=1,N
          IF(BLOCK(J).EQ.HOLD)THEN
            ICOUNT=ICOUNT+1
            YRANK(J)=XTEMP(ICOUNT)
          ENDIF
 2130   CONTINUE
 2110 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
        DO2140I=1,N
          WRITE(ICOUT,2142)I,Y(I),YRANK(I)
 2142     FORMAT('I,Y(I),YRANK(I) = ',I8,E15.7,F12.2)
          CALL DPWRST('XXX','BUG ')
 2140   CONTINUE
      ENDIF
C
C  STEP 3: NOW COMPUTE RANK SUMS FOR EACH TREATMENT
C
      DO2210I=1,NTREAT
        HOLD=DTREAT(I)
        DSUM1=0.0D0
        DO2220J=1,N
          IF(TREAT(J).EQ.HOLD)THEN
            DSUM1=DSUM1 + DBLE(YRANK(J))
          ENDIF
 2220   CONTINUE
        RJ(I)=REAL(DSUM1)
 2210 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
        DO2240I=1,NTREAT
          WRITE(ICOUT,2242)I,RJ(I)
 2242     FORMAT('I,RJ(I) = ',I8,E15.7)
          CALL DPWRST('XXX','BUG ')
 2240   CONTINUE
      ENDIF
C
C  STEP 4: NOW COMPUTE VARIOUS QUANTITIES BASED ON RJ
C
      DSUM2=0.0D0
      DO2310I=1,N
        DSUM2=DSUM2 + DBLE(YRANK(I))**2
 2310 CONTINUE
      A=REAL(DSUM2)
      B=REAL(NBLOCK)
      T=REAL(NTREAT)
      R=REAL(NR)
      AK=REAL(NK)
      C=B*AK*(AK+1)**2/4.0
      DENOM=A-C
      C1=(T-1.0)
      C2=R*C
C
      DSUM1=0.0D0
      DO2320I=1,NTREAT
        DSUM1=DSUM1 + RJ(I)**2
 2320 CONTINUE
      T1=C1*(REAL(DSUM1)-C2)/DENOM
      T2=(T1/C1)/((B*(AK-1.0) - T1)/(B*AK - B - T + 1.0))
C
      STATVA=T2
      NUMDF1=NTREAT-1
      NUMDF2=INT(B*AK - B - T +1)
      CALL FCDF(STATVA,NUMDF1,NUMDF2,STATCD)
C
      CUT0=0.0
      CALL FPPF(.50,NUMDF1,NUMDF2,CUT50)
      CALL FPPF(.75,NUMDF1,NUMDF2,CUT75)
      CALL FPPF(.90,NUMDF1,NUMDF2,CUT90)
      CALL FPPF(.95,NUMDF1,NUMDF2,CUT95)
      CALL FPPF(.99,NUMDF1,NUMDF2,CUT99)
      CALL FPPF(.999,NUMDF1,NUMDF2,CUT999)
C
      IDF=INT(B*AK - B - T + 1.0)
      CALL TPPF(0.95,IDF,T95)
      CALL TPPF(0.975,IDF,T975)
      CALL TPPF(0.995,IDF,T995)
      TERM1=(A-C)*2.0*R/(B*AK - B - T + 1.0)
      TERM2=1.0 - (T1/(B*(AK - 1.0)))
      CONTRA=SQRT(TERM1*TERM2)
      CONTR1=T95*CONTRA
      CONTR2=T975*CONTRA
      CONTR3=T995*CONTRA
C
      ICONC1='ACCEPT'
      ICONC2='ACCEPT'
      ICONC3='ACCEPT'
C
      IF(STATVA.GT.CUT95)ICONC2='REJECT'
C
C               *****************************
C               **   STEP 42-              **
C               **   WRITE OUT THE TABLE   **
C               *****************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='DUR2'
      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='DUR2'
      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
      WRITE(IOUNI1,2005)
 2005 FORMAT(4X,'RESPONSE',13X,'RANK',11X,'BLOCK',8X,'TREATMENT')
      DO2010I=1,N
        WRITE(IOUNI1,2011)Y(I),YRANK(I),BLOCK(I),TREAT(I)
 2011   FORMAT(1X,E15.7,F15.2,F15.2,F15.2)
 2010 CONTINUE
C
      WRITE(IOUNI2,2021)CONTRA
 2021 FORMAT(1X,'Contrast term:          ',E15.7)
      WRITE(IOUNI2,2022)CONTR1
 2022 FORMAT(1X,'Contrast term*t(0.95):  ',E15.7)
      WRITE(IOUNI2,2023)CONTR2
 2023 FORMAT(1X,'Contrast term*t(0.975): ',E15.7)
      WRITE(IOUNI2,2024)CONTR3
 2024 FORMAT(1X,'Contrast term*t(0.995): ',E15.7)
      WRITE(IOUNI2,2025)
 2025 FORMAT(10X,'I',10X,'J',8X,'|R(I)-R(J)|')
C
      DO2030I=1,NTREAT
        DO2039J=1,NTREAT
          IF(I.LT.J)THEN
            ADIFF=ABS(RJ(I)-RJ(J))
            IATEMP='   '
            IF(ABS(ADIFF).GE.CONTR1)IATEMP(1:1)='*'
            IF(ABS(ADIFF).GE.CONTR2)IATEMP(2:2)='*'
            IF(ABS(ADIFF).GE.CONTR3)IATEMP(3:3)='*'
            WRITE(IOUNI2,2037)I,J,ADIFF,IATEMP
 2037       FORMAT(3X,I8,3X,I8,5X,E15.7,A3)
          ENDIF
 2039   CONTINUE
 2030 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               **   STEP 43--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR DURBIN TEST        **
C               ******************************
C
      ISTEPN='43'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: WRITE HEADER
C
        WRITE(ICOUT,5001)
 5001   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5002)
 5002   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5003)
 5003   FORMAT('<B>DURBIN TEST FOR IDENTICAL TREATMENT ',
     1         'EFFECTS:<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
 5013   FORMAT('TWO-WAY BALANCED INCOMPLETE BLOCK DESIGN</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
 5004   FORMAT('</CENTER> <BR><BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START LIST
C
        WRITE(ICOUT,5005)
 5005   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2A: LIST ITEM 1
C
        WRITE(ICOUT,5006)
 5006   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
 5007   FORMAT('       <P>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
 5011   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
 5021   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
 5023   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5025)
 5025   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
 5027   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
 5026   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=200>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)N
 5029   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
 5028   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5041)
 5041   FORMAT('               Number of Blocks:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NBLOCK
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5042)
 5042   FORMAT('               Number of Treatments:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NTREAT
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5942)
 5942   FORMAT('               Number of Blocks For Each ',
     1         'Treatment')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5029)NR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5044)
 5044   FORMAT('               A (Sum of Squares of Ranks):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)A
 5051   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
 5045   FORMAT('               C (Correction Factor):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)C1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
 5047   FORMAT('               Durbin T1 Test Statistic ',
     1         '(Uncorrected):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)T1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5046)
 5046   FORMAT('               Durbin T2 Test Statistic ',
     1         '(Corrected):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)STATVA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
 5091   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: LIST ITEM 2
C
        WRITE(ICOUT,5066)
 5066   FORMAT('   <LI>Percent Points of the F Reference ',
     1         'Distribution<br>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5067)
 5067   FORMAT('       for DURBIN Test Statistic:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
 5071   FORMAT('               0    Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
 5072   FORMAT('               50   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT50
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
 5073   FORMAT('               75   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT75
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
 5074   FORMAT('               90   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
 5075   FORMAT('               95   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
 5076   FORMAT('               99   Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5077)
 5077   FORMAT('               99.9 Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CUT999
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5021)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5023)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5078)100.0*STATCD
 5078   FORMAT('<br>               ',G15.7,' Percent Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5026)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)STATVA
 5052   FORMAT('<br>            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5027)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5028)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2C: LIST ITEM 3
C
        WRITE(ICOUT,5081)
 5081   FORMAT('   <LI>Conclusion (at the 5% level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,5087)NTREAT
 5087     FORMAT('        The ',I8,' treatments have identical ',
     1           'effects.')
        ELSE
          WRITE(ICOUT,5088)NTREAT
 5088     FORMAT('        The ',I8,' treatments do not have ',
     1           'identical effects.')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
 5093   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5095)
 5095   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf DURBIN TEST FOR IDENTICAL TREATMENT ',
     1         'EFFECTS:}')
 8091   FORMAT('{',A1,'bf TWO-WAY BALANCED INCOMPLETE BLOCK ',
     1         'DESIGNS}')
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT(A1,'begin{center}')
 8005   FORMAT(A1,'end{center}')
 8006   FORMAT(A1,'end{verbatim}')
 8007   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
 8011   FORMAT(A1,'begin{enumerate}')
 8012   FORMAT(A1,'end{enumerate}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(11X,A1,'newline')
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Percent Points of the F Reference ',
     1         'Distribution:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Number of Blocks: & ',I8,2X,A1,A1)
 8033   FORMAT(11X,'Number of Treatments: & ',I8,2X,A1,A1)
 8933   FORMAT(11X,'Number of Blocks for Each Treatment: & ',
     1         I8,2X,A1,A1)
 8034   FORMAT(11X,'Durbin Test Statistic T1 (Uncorrected): & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(11X,'A (Sum of Squares of Ranks): & ',G15.7,2X,A1,A1)
 8036   FORMAT(11X,'C (Correction Factor): & ',G15.7,2X,A1,A1)
 8037   FORMAT(11X,'Durbin Test Statistic T2 (Corrected): & ',
     1         G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8041   FORMAT(11X,G15.7,' Percent Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'The ',I8,' treatments have identical effects.',
     1         2X,A1,A1)
 8043   FORMAT(11X,'The ',I8,' treatments do not have identical ',
     1         'effects.',2X,A1,A1)
 8044   FORMAT(11X,'0      Percent Point: & ',G15.7,2X,A1,A1)
 8045   FORMAT(11X,'50     Percent Point: & ',G15.7,2X,A1,A1)
 8046   FORMAT(11X,'90     Percent Point: & ',G15.7,2X,A1,A1)
 8047   FORMAT(11X,'95     Percent Point: & ',G15.7,2X,A1,A1)
 8048   FORMAT(11X,'99     Percent Point: & ',G15.7,2X,A1,A1)
 8049   FORMAT(11X,'99.9   Percent Point: & ',G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)NBLOCK,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8033)NTREAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8933)NR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8035)A,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8036)C,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)T1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8037)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)CUT0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8045)CUT50,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8046)CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8047)CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8048)CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)CUT999,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)100.*STATCD,STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,8042)NTREAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8043)NTREAT,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8051   FORMAT(A1,'end{enumerate}')
 8052   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8051)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8052)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7211)
 7211   FORMAT('              DURBIN TEST FOR IDENTICAL ',
     1         'TREATMENT EFFECTS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7213)
 7213   FORMAT('              TWO-WAY BALANCED, INCOMPLETE ',
     1         'BLOCK DESIGNS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7220)
 7220   FORMAT('1. STATISTICS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7221)N
 7221   FORMAT(6X,'NUMBER OF OBSERVATIONS                 = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7222)NBLOCK
 7222   FORMAT(6X,'NUMBER OF BLOCKS                       = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7223)NTREAT
 7223   FORMAT(6X,'NUMBER OF TREATMENTS                   = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7224)NR
 7224   FORMAT(6X,'NUMBER OF BLOCKS FOR EACH TREATMENT    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7225)A
 7225   FORMAT(6X,'A (SUM OF SQUARES OF RANKS)            = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7226)C
 7226   FORMAT(6X,'C (CORRECTION FACTOR)                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7227)T1
 7227   FORMAT(6X,'DURBIN TEST STATISTIC T1 (UNCORRECTED) = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7228)STATVA
 7228   FORMAT(6X,'DURBIN TEST STATISTIC T2 (CORRECTED)   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7240)
 7240   FORMAT('2. PERCENT POINTS OF THE F REFERENCE DISTRIBUTION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7241)
 7241   FORMAT('   FOR DURBIN TEST STATISTIC')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7265)CUT0
 7265   FORMAT(6X,'0          % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7266)CUT50
 7266   FORMAT(6X,'50         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7267)CUT75
 7267   FORMAT(6X,'75         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7268)CUT90
 7268   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7269)CUT95
 7269   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7270)CUT99
 7270   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7271)CUT999
 7271   FORMAT(6X,'99.9       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7280)100.*STATCD,STATVA
 7280   FORMAT(6X,G15.7,'   % Point:  ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,7291)
 7291   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LE.CUT95)THEN
          WRITE(ICOUT,7293)NTREAT
 7293     FORMAT(6X,'THE ',I8,' TREATMENTS HAVE IDENTICAL EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,7295)NTREAT
 7295     FORMAT(6X,'THE ',I8,' TREATMENTS DO NOT HAVE IDENTICAL ',
     1           'EFFECTS')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,9212)
 9212     FORMAT(6X,'RESPONSE, RANKED RESPONSE, BLOCK AND TREATMENT ',
     1           ' WRITTEN TO FILE DPST1F.DAT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,9214)
 9214     FORMAT(6X,'TREATMENT RANKS AND COMPARISONS WRITTEN TO FILE ',
     1           ' DPST2F.DAT')
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
      ENDIF
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'DUR2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPDUR2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012   FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,9015)N
 9015   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPECDF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN EMPIRICAL CDF 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-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
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 ISUBRO
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPEC'
      ISUBN2='DF  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLV2=0
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ECDF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C
C               ***********************************
C               **  TREAT THE EMPIRICAL CDF PLOT **
C               ***********************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  SEARCH FOR EMPIRICAL CDF, ECDF       **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='ECDF'
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ECDF'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EMPI'.AND.IHARG(1).EQ.'CDF '.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASPL.EQ.'ECDF')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPECDF')
      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 TO    ECDF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,MIN(IWIDTH,80))
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=2
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     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 12--                                        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.           **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IHLEFT,IHLEF2
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A EMPIRICAL CDF PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IS TO BE GENERATED)')
      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)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ********************************************
C               **  STEP 13--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  (THIS WILL BE THE TAG      VARIABLE)  **
C               ********************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)THEN
        NUMV=1
        ICOLR=-1
        NRIGHT=-1
      ELSE 
        IHRIGH=IHARG(2)
        IHRIG2=IHARG2(2)
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
          NUMV=1
          ICOLR=-1
          NRIGHT=-1
        ELSE
          NUMV=2
          ICOLR=IVALUE(ILOCV)
          NRIGHT=IN(ILOCV)
        ENDIF
      ENDIF
C
C               ******************************************************
C               **  STEP 14--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  FOR THE TAG VARIABLE (NRIGHT) IS THE SAME AS    **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE     **
C               ** VARIABLE.                                        **
C               ******************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV.LT.2)GOTO1490
      IF(NUMV.EQ.2.AND.NLEFT.EQ.NRIGHT)GOTO1490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      IF TWO VARIABLES ARE SPECIFED FOR THE ',
     1'ECDFAN-MEIER PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      THEY MUST HAVE THE SAME NUMBER OF OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)IHLEFT,IHLEF2,NLEFT
 1415 FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1416)IHRIGH,IHRIG2,NRIGHT
 1416 FORMAT('      ',A4,A4,' HAS ',I8,' OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1417)
 1417 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1418)(IANS(I),I=1,MIN(IWIDTH,80))
 1418 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1490 CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ECDF')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EITHER 1 OR 2                           **
C               **  FOR A EMPIRICAL CDF PLOT).                **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO2209
      GOTO2250
C
 2209 CONTINUE
      IF(NUMV2.LE.2)GOTO2290
C
 2250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR A EMPIRICAL CDF PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)NUMV2
 2257 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)
 2258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2259)(IANS(I),I=1,MIN(IWIDTH,80))
 2259 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               **********************************************
C               **  STEP 31--                               **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE BY                   **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='31'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO3110
      IF(ICASQ.EQ.'SUBS')GOTO3120
      IF(ICASQ.EQ.'FOR')GOTO3130
C
 3110 CONTINUE
      DO3115I=1,NLEFT
      ISUB(I)=1
 3115 CONTINUE
      NQ=NLEFT
      GOTO3150
C
 3120 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3150
C
 3130 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3150
C
 3150 CONTINUE
      IF(NQ.GE.MINN2)GOTO3160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** ERROR IN DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)
 3152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IHLEFT,IHLEF2
 3153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)
 3154 FORMAT('      (FOR WHICH A EMPIRICAL CDF PLOT IS TO BE ',
     1'FORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3156)MINN2
 3156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3157)
 3157 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3158)
 3158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3159)(IANS(I),I=1,MIN(IWIDTH,80))
 3159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3160 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3170
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMV.EQ.1)THEN
        X1(J)=-1.0
        GOTO3170
      ENDIF
      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)
C
 3170 CONTINUE
      NS=J
C
C               *******************************************************
C               **  STEP 41--                                        **
C               **  FORM THE VERTICAL AND HORIZONTALAXIS             **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE PLOT. **
C               **  FORM THE CURVE DESIGNATION VARIABLED(.)  .       **
C               **  THIS WILL BE ALL ONES.                           **
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.'ECDF')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPECD2(Y1,X1,NS,NUMV,ICASPL,MAXN,
     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.'ECDF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPECDF--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      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 DPECD2(Y1,X1,N,NUMV,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN EMPIRICAL CDF PLOT
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                               IF X1 IS SPECIFIED, THEN Y1 BECOMES
C                               A FREQUENCY VARIABLE
C                      X1   = IF SPECIFIED, IT REPRESENTS THE
C                             OBSERVATION POINTS (AND Y1 IS THE
C                             FREQUENCY)
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR 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-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
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='DPEC'
      ISUBN2='D2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ECD2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPECD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,NUMV,ICASPL,MAXN
   53 FORMAT('N,NUMV,ICASPL,MAXN = ',2I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y1(I),X1(I)
   56 FORMAT('I, Y1(I), X1(I), = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPECD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)N
  114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y1(1)
      DO120I=1,N
      IF(Y1(I).NE.HOLD)GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** ERROR IN DPECD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,123)HOLD
  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  129 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  COMPUTE COORDINATES FOR EMPIRICAL CDF PLOT**
C               **  (INCORPORATE STAIR-STEP APPEARANCE)      **
C               ***********************************************
C
      IF(NUMV.EQ.1)THEN
        CALL SORT(Y1,N,Y1)
        J=1
        X(J)=Y1(1)
        Y(J)=0.0
        D(J)=1.0
        J=2
        X(J)=Y1(1)
        Y(J)=1.0/REAL(N)
        D(J)=1.0
        DO200I=2,N
          J=J+1
          X(J)=Y1(I)
          Y(J)=REAL(I-1)/REAL(N)
          D(J)=1.0
          J=J+1
          X(J)=Y1(I)
          Y(J)=REAL(I)/REAL(N)
          D(J)=1.0
  200   CONTINUE
      ELSE
        CALL SORTC(X1,Y1,N,X1,Y1)
        IWRITE='OFF'
        CALL SUM(Y1,N,IWRITE,YSUM,IBUGG3,IERROR)
        CALL CUMSUM(Y1,N,IWRITE,Y1,IBUGG3,IERROR)
        J=1
        X(J)=X1(1)
        Y(J)=0.0
        D(J)=1.0
        J=2
        X(J)=X1(1)
        Y(J)=Y1(1)/REAL(YSUM)
        D(J)=1.0
        DO300I=2,N
          J=J+1
          X(J)=X1(I)
          Y(J)=Y1(I-1)/YSUM
          D(J)=1.0
          J=J+1
          X(J)=X1(I)
          Y(J)=Y1(I)/YSUM
          D(J)=1.0
  300   CONTINUE
      ENDIF
C
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ECD2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPECD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,ICASPL,MAXN
 9013 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y1(I)
 9016 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NPLOTP,NPLOTV
 9021 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NPLOTP
      WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
 9023 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
