      SUBROUTINE DPTISC(ICOM,IHARG,NUMARG,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
C              (LINEAR OR WEIBULL OR NORMAL)
C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
C     FOCUS OF SUBROUTINE DPTISC--LOG
C                         DPTIS2--WEIBULL
C                         DPTIS3--NORMAL
C
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  BOTH HORIZONTAL LOG SCALES  ARE TO BE LOG      **
C               *****************************************************
C
      IF(ICOM.EQ.'XLOG')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IX1TSC='LOG'
      IX2TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE XLOG SWITCH (FOR BOTH HORIZONTAL LOG SCALES ) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE XLOG SWITCH (FOR BOTH HORIZONTAL LOG SCALES ) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE LOG      **
C               **************************************************************
C
      IF(ICOM.EQ.'X1LO')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IX1TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X1LOG   SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X1LOG   SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE LOG      **
C               **************************************************************
C
      IF(ICOM.EQ.'X2LO')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
      IERROR='YES'
      GOTO1900
C
 1310 CONTINUE
      IFOUND='YES'
      IX2TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X2LOG   SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X2LOG   SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ***************************************************
C               **  TREAT THE CASE WHEN                          **
C               **  BOTH VERTICAL LOG SCALES  ARE TO BE LOG      **
C               ***************************************************
C
      IF(ICOM.EQ.'YLOG')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
      IERROR='YES'
      GOTO1900
C
 1410 CONTINUE
      IFOUND='YES'
      IY1TSC='LOG'
      IY2TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE YLOG   SWITCH (FOR BOTH VERTICAL LOG SCALES ) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE YLOG   SWITCH (FOR BOTH VERTICAL LOG SCALES ) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE LOG      **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1LO')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
      IERROR='YES'
      GOTO1900
C
 1510 CONTINUE
      IFOUND='YES'
      IY1TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y1LOG   SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y1LOG   SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE LOG      **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2LO')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
      IERROR='YES'
      GOTO1900
C
 1610 CONTINUE
      IFOUND='YES'
      IY2TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y2LOG   SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y2LOG   SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME LOG SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN                         **
C               **  THE ENTIRE 4-SIDED FRAME IS TO BE LOG       **
C               **************************************************
C
      IF(ICOM.EQ.'XYLO')GOTO1700
      IF(ICOM.EQ.'YXLO')GOTO1700
      IF(ICOM.EQ.'LOG ')GOTO1700
      IF(ICOM.EQ.'LOGL')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
      IERROR='YES'
      GOTO1900
C
 1710 CONTINUE
      IFOUND='YES'
      IX1TSC='LOG'
      IX2TSC='LOG'
      IY1TSC='LOG'
      IY2TSC='LOG'
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE LOG   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE LOG   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTIS2(ICOM,IHARG,NUMARG,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
C              (LINEAR OR WEIBULL OR NORMAL)
C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
C     FOCUS OF SUBROUTINE DPTISC--LOG
C                         DPTIS2--WEIBULL
C                         DPTIS3--NORMAL
C
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
C
C               ********************************************************
C               **  TREAT THE CASE WHEN                               **
C               **  BOTH HORIZONTAL FRAME LINES     ARE TO BE WEIBULL **
C               ********************************************************
C
      IF(ICOM.EQ.'XWEI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IX1TSC='WEIB'
      IX2TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE XWEIB SWITCH (FOR BOTH HORIZ. WEIBULL SCALES)',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE XWEIB SWITCH (FOR BOTH HORIZ. WEIBULL SCALES)',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE WEIBU
C               ********************************************************
C
      IF(ICOM.EQ.'X1WE')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IX1TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X1WEIB   SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X1WEIB   SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE WEIBU
C               ********************************************************
C
      IF(ICOM.EQ.'X2WE')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
      IERROR='YES'
      GOTO1900
C
 1310 CONTINUE
      IFOUND='YES'
      IX2TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X2WEIB   SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X2WEIB   SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ******************************************************
C               **  TREAT THE CASE WHEN                             **
C               **  BOTH VERTICAL FRAME LINES     ARE TO BE WEIBULL **
C               ******************************************************
C
      IF(ICOM.EQ.'YWEI')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
      IERROR='YES'
      GOTO1900
C
 1410 CONTINUE
      IFOUND='YES'
      IY1TSC='WEIB'
      IY2TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE YWEIB   SWITCH (FOR BOTH VERT. WEIBULL SCALES)',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE YWEIB   SWITCH (FOR BOTH VERT. WEIBULL SCALES)',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE WEIBU
C               ********************************************************
C
      IF(ICOM.EQ.'Y1WE')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
      IERROR='YES'
      GOTO1900
C
 1510 CONTINUE
      IFOUND='YES'
      IY1TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y1WEIB   SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y1WEIB   SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE WEIBU
C               ********************************************************
C
      IF(ICOM.EQ.'Y2WE')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
      IERROR='YES'
      GOTO1900
C
 1610 CONTINUE
      IFOUND='YES'
      IY2TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y2WEIB   SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y2WEIB   SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME WEIBULL SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN                         **
C               **  THE ENTIRE 4-SIDED FRAME IS TO BE WEIBULL       **
C               **************************************************
C
      IF(ICOM.EQ.'XYWE')GOTO1700
      IF(ICOM.EQ.'YXWE')GOTO1700
      IF(ICOM.EQ.'WEIB')GOTO1700
CCCCC IF(ICOM.EQ.'WEIW'GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
      IERROR='YES'
      GOTO1900
C
 1710 CONTINUE
      IFOUND='YES'
      IX1TSC='WEIB'
      IX2TSC='WEIB'
      IY1TSC='WEIB'
      IY2TSC='WEIB'
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE WEIBULL   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE WEIBULL   SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTIS3(ICOM,IHARG,NUMARG,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC SCALES CONTAINED IN THE
C              4 VARIABLES IX1TSC,IX2TSC,IY1TSC,IY2TSC  .
C              SUCH TIC SCALE SWITCHES DEFINE THE SCALES
C              (LINEAR OR WEIBULL OR NORMAL)
C              FOR THE TICS ON THE 4 FRAME LINES OF A PLOT.
C     FOCUS OF SUBROUTINE DPTISC--LOG
C                         DPTIS2--WEIBULL
C                         DPTIS3--NORMAL
C
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1TSC = LOWER HORIZONTAL TIC SCALE
C                     --IX2TSC = UPPER HORIZONTAL TIC SCALE
C                     --IY1TSC = LEFT  VERTICAL   TIC SCALE
C                     --IY2TSC = RIGHT VERTICAL   TIC SCALE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1TSC
      CHARACTER*4 IX2TSC
      CHARACTER*4 IY1TSC
      CHARACTER*4 IY2TSC
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORN')GOTO1900
C
C               ********************************************************
C               **  TREAT THE CASE WHEN                               **
C               **  BOTH HORIZONTAL FRAME LINES     ARE TO BE NORMAL  **
C               ********************************************************
C
      IF(ICOM.EQ.'XNOR')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1110
      IF(IHARG(NUMARG).EQ.'ON')GOTO1110
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1110
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1110
      IERROR='YES'
      GOTO1900
C
 1110 CONTINUE
      IFOUND='YES'
      IX1TSC='NORM'
      IX2TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('THE XNORM SWITCH (FOR BOTH HORIZ. NORMAL  SCALES)',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('THE XNORM SWITCH (FOR BOTH HORIZ. NORMAL  SCALES)',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE BOTTOM HORIZONTAL FRAME LINE IS TO BE NOR
C               ********************************************************
C
      IF(ICOM.EQ.'X1NO')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.LE.0)GOTO1210
      IF(IHARG(NUMARG).EQ.'ON')GOTO1210
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1210
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1210
      IERROR='YES'
      GOTO1900
C
 1210 CONTINUE
      IFOUND='YES'
      IX1TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('THE X1NORMAL SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1219 CONTINUE
      GOTO1900
C
 1220 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1225)
 1225 FORMAT('THE X1NORMAL SWITCH (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1229 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE TOP    HORIZONTAL FRAME LINE IS TO BE NORM
C               ********************************************************
C
      IF(ICOM.EQ.'X2NO')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.LE.0)GOTO1310
      IF(IHARG(NUMARG).EQ.'ON')GOTO1310
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1310
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1310
      IERROR='YES'
      GOTO1900
C
 1310 CONTINUE
      IFOUND='YES'
      IX2TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('THE X2NORMAL SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      GOTO1900
C
 1320 CONTINUE
      IFOUND='YES'
      IX2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('THE X2NORMAL SWITCH (FOR THE TOP HORIZONTAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1329 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               ******************************************************
C               **  TREAT THE CASE WHEN                             **
C               **  BOTH VERTICAL FRAME LINES     ARE TO BE NORMAL  **
C               ******************************************************
C
      IF(ICOM.EQ.'YNOR')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(NUMARG.LE.0)GOTO1410
      IF(IHARG(NUMARG).EQ.'ON')GOTO1410
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1420
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1410
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1410
      IERROR='YES'
      GOTO1900
C
 1410 CONTINUE
      IFOUND='YES'
      IY1TSC='NORM'
      IY2TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('THE YNORM   SWITCH (FOR BOTH VERT. NORMAL  SCALES)',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1419 CONTINUE
      GOTO1900
C
 1420 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1425)
 1425 FORMAT('THE YNORM   SWITCH (FOR BOTH VERT. NORMAL  SCALES)',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1429 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE LEFT   VERTICAL   FRAME LINE IS TO BE NORM
C               ********************************************************
C
      IF(ICOM.EQ.'Y1NO')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.LE.0)GOTO1510
      IF(IHARG(NUMARG).EQ.'ON')GOTO1510
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1520
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1510
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1510
      IERROR='YES'
      GOTO1900
C
 1510 CONTINUE
      IFOUND='YES'
      IY1TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1519
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1515)
 1515 FORMAT('THE Y1NORMAL SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1519 CONTINUE
      GOTO1900
C
 1520 CONTINUE
      IFOUND='YES'
      IY1TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1529
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1525)
 1525 FORMAT('THE Y1NORMAL SWITCH (FOR THE LEFT VERTICAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1529 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               ********************************************************
C               **  TREAT THE CASE WHEN
C               **  ONLY THE RIGHT  VERTCIAL   FRAME LINE IS TO BE NORM
C               ********************************************************
C
      IF(ICOM.EQ.'Y2NO')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.LE.0)GOTO1610
      IF(IHARG(NUMARG).EQ.'ON')GOTO1610
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1620
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1610
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1610
      IERROR='YES'
      GOTO1900
C
 1610 CONTINUE
      IFOUND='YES'
      IY2TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1619
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1615)
 1615 FORMAT('THE Y2NORMAL SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1619 CONTINUE
      GOTO1900
C
 1620 CONTINUE
      IFOUND='YES'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1629
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1625)
 1625 FORMAT('THE Y2NORMAL SWITCH (FOR THE RIGHT VERTICAL ',
     1'FRAME NORMAL  SCALE ONLY) HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1629 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               **************************************************
C               **  TREAT THE CASE WHEN                         **
C               **  THE ENTIRE 4-SIDED FRAME IS TO BE NORMAL        **
C               **************************************************
C
      IF(ICOM.EQ.'XYNO')GOTO1700
      IF(ICOM.EQ.'YXNO')GOTO1700
CCCCC IF(ICOM.EQ.'NORM')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(NUMARG.LE.0)GOTO1710
      IF(IHARG(NUMARG).EQ.'ON')GOTO1710
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1720
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1710
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1710
      IERROR='YES'
      GOTO1900
C
 1710 CONTINUE
      IFOUND='YES'
      IX1TSC='NORM'
      IX2TSC='NORM'
      IY1TSC='NORM'
      IY2TSC='NORM'
C
      IF(IFEEDB.EQ.'OFF')GOTO1719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1715)
 1715 FORMAT('THE NORMAL    SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
 1719 CONTINUE
      GOTO1900
C
 1720 CONTINUE
      IFOUND='YES'
      IX1TSC='LINE'
      IX2TSC='LINE'
      IY1TSC='LINE'
      IY2TSC='LINE'
C
      IF(IFEEDB.EQ.'OFF')GOTO1729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1725)
 1725 FORMAT('THE NORMAL    SWITCH (FOR THE ENTIRE 4-SIDED FRAME) ',
     1'HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1729 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTISZ(IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PTITHE,PTITWI,PTITVG,PTITHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SIZE FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE SIZE FOR THE TITLE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PTITHE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEFHE
C                     --PDEFWI
C     OUTPUT ARGUMENTS--PTITHE = TITLE HEIGHT
C                     --PTITWI = TITLE WIDTH
C                     --PTITVG = TITLE VERTICAL GAP
C                     --PTITHG = TITLE HORIZONTAL GAP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1988.  DEFAULT WIDTH
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1199
      IF(IHARG(1).NE.'SIZE')GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1110
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPTISZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR TITLE SIZE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE IT IS DESIRED TO HAVE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      THE TITLE ONE AND ONE HALF TIMES AS BIG ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AS THE DEFAULT SIZE (WHICH IS SIZE 1), ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      TITLE SIZE 1.5 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      PTITHE=PDEFHE
      PTITWI=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      PTITHE=ARG(NUMARG)
      PTITWI=PTITHE*0.5
      PTITVG=PTITHE*0.375
      PTITHG=PTITHE*0.125
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)PTITHE
 1181 FORMAT('THE TITLE SIZE HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTIT(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
CCCCC SUBROUTINE DPTIT(IANS,IWIDTH,IHARG,IHARG2,NUMARG,
CCCCC THE ABOVE LINE WAS CHANGED        SEPTEMBER 1993
CCCCC SO AS TO ALLOW FOR LOWER CASE     SEPTEMBER 1993
CCCCC SUBROUTINE DPTIT(IANS,IWIDTH,IHARG,NUMARG,
CCCCC THE ABOVE LINE WAS AUGMENTED AUGUST 1992
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
CCCCC1ITITTE,NCTITL,IBUGP2,IFOUND,IERROR)
     1ITITTE,NCTITL,ITIAUT,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--EXTRACT THE STRING TO BE USED AS A TITLE;
C              SAVE THIS STRING FOR USE ON PRINTER PLOTS;
C              ALSO, CONVERT THIS STRING INTO PROPER FORM
C              (ASCII INTEGER REPRESENTATION) FOR USE
C              WITH TEKTRONIX (OR EQUIVALENT) SOFTWARE.
C     INPUT  ARGUMENTS--IANS   (A  CHARACTER VECTOR)
C                     --IWIDTH
C                     --IHARG  (A  CHARACTER VECTOR)
C                     --IHARG2  (A  CHARACTER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ITITTE (A CHARACTER VECTOR
C                              CONTAINING THE STRING FOR THE TITLE).
C                     --NCTITL  (AN INTEGER VARIABLE
C                              CONTAINING THE
C                              NUMBER OF CHARACTERS IN THE TITLE).
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY    1978.
C     UPDATED         --JUNE       1978.
C     UPDATED         --JUNE       1979.
C     UPDATED         --SEPTEMBER  1980.
C     UPDATED         --MARCH      1981.
C     UPDATED         --DECEMBER   1981.
C     UPDATED         --MAY        1982.
C     UPDATED         --AUGUST     1992. ADD TITLE SWITCH
C                                        FOR AUTOMATIC
C     UPDATED         --SEPTEMBER  1993. ALLOW LOWER CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      CHARACTER*4 IHARG2
C
      CHARACTER*4 ITITTE
C
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      CHARACTER*4 ITIAUT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
      DIMENSION IHARG2(*)
C
      DIMENSION ITITTE(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGP2.NE.'ON')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPTIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NCTITL
   53 FORMAT('NCTITL = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILENT=NCTITL
      WRITE(ICOUT,41)(ITITTE(I),I=1,ILENT)
   41 FORMAT('CHARACTER ITITTE(.) --',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C     *****************************************
C     **  STEP 1--                           **
C     **  DETERMINE THE COMMAND              **
C     **  (TITLE) AND ITS LOCATION           **
C     **  ON THE LINE.                       **
C     *****************************************
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'COLO')GOTO9000
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'SIZE')GOTO9000
      IF(NUMARG.EQ.2.AND.IHARG(1).EQ.'SIZE')GOTO9000
C
      DO1000I=1,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IF(IANS(I).EQ.'T'.AND.IANS(IP1).EQ.'I'
     1.AND.IANS(IP2).EQ.'T'.AND.IANS(IP3).EQ.'L'
     1.AND.IANS(IP4).EQ.'E')
     1GOTO100
C
 1000 CONTINUE
      WRITE(ICOUT,1001)
 1001 FORMAT('***** ERROR IN DPTIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1002)
 1002 FORMAT('      NO MATCH FOR COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO800
C
C     **********************************************************
C     **  STEP 2--                                            **
C     **  DEFINE THE START POSITION (ISTART) FOR THE STRING.  **
C     **********************************************************
C
  100 CONTINUE
      ISTART=I2+6
      GOTO300
C
C     ********************************************************
C     **  STEP 3--                                          **
C     **  DEFINE THE STOP POSITION (ISTOP) FOR THE STRING.  **
C     ********************************************************
C
  300 CONTINUE
      IFOUND='YES'
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO329
      DO320I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO325
  320 CONTINUE
      GOTO329
  325 CONTINUE
      ISTOP=IREV
  329 CONTINUE
C
C     *****************************************
C     **  STEP 4--                           **
C     **  COPY OVER THE STRING OF INTEREST.  **
C     *****************************************
C
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'ON')GOTO359
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'OFF')GOTO359
CCCCC IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO')GOTO359
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'DEFA')GOTO359
      IF(NUMARG.EQ.0)GOTO359
C
      IF(ISTART.GT.ISTOP)GOTO359
      IF(ISTOP.EQ.0)GOTO359
      J=0
      DO350I=ISTART,ISTOP
      J=J+1
CCCCC THE FOLLOWING LINE WAS   CHANGED   SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC ITITTE(J)=IANS(I)
      ITITTE(J)=IANSLC(I)
  350 CONTINUE
      NCTITL=J
      GOTO800
  359 CONTINUE
C
C     ************************************
C     **  STEP 5--                      **
C     **  TREAT THE EMPTY-STRING CASE.  **
C     ************************************
C
      NCTITL=0
      GOTO800
C
C     ***************************
C     **  STEP 6--             **
C     **  PRINT OUT A MESSAGE  **
C     ***************************
C
  800 CONTINUE
      ILENT=NCTITL
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED AUGUST 1992
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'AUTO'.AND.
     1IHARG2(1).EQ.'MATI')THEN
         ITIAUT='ON'
      ELSE
         ITIAUT='OFF'
      ENDIF
      IF(IFEEDB.EQ.'OFF')GOTO889
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)
  811 FORMAT('THE TITLE HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(ILENT.EQ.0)WRITE(ICOUT,999)
      IF(ILENT.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(ILENT.GE.1)WRITE(ICOUT,812)(ITITTE(I),I=1,ILENT)
  812 FORMAT(10X,120A1)
      IF(ILENT.GE.1)CALL DPWRST('XXX','BUG ')
  889 CONTINUE
      GOTO9000
C
C     ****************
C     **  STEP 90-- **
C     **  EXIT      **
C     ****************
C
 9000 CONTINUE
      IF(IBUGP2.NE.'ON')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPTIT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NCTITL
 9012 FORMAT('NCTITL = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILENT=NCTITL
      WRITE(ICOUT,9021)(ITITTE(I),I=1,ILENT)
 9021 FORMAT('CHARACTER ITITTE(.) --',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTIDS(IHARG,ARG,NUMARG,PDEFDS,PTITDS,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE DISPLACEMENT FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE DISPLACEMENT FOR THE TITLE WILL BE PLACED
C              IN THE REAL VARIABLE PTITDS.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A  REAL VECTOR)
C                     --NUMARG
C                     --PDEFDS
C     OUTPUT ARGUMENTS--PTITDS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/8
C     ORIGINAL VERSION--JULY      1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1199
      IF(IHARG(1).EQ.'DISP')GOTO1110
      IF(IHARG(1).EQ.'OFFS')GOTO1110
      IF(IHARG(1).EQ.'GAP')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PTITDS=PDEFDS
      GOTO1180
C
 1160 CONTINUE
      PTITDS=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)PTITDS
 1181 FORMAT('THE TITLE DISPLACEMENT HAS JUST BEEN ',
     1'SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPTITH(IHARG,ARG,NUMARG,PDEFTH,PTITTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR THE TITLE
C              (THE HORIZONTAL STRING ABOVE THE UPPER HORIZONTAL FRAME).
C              THE THICKNESS FOR THE TITLE WILL BE PLACED
C              IN THE REAL VARIABLE PTITTH.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A  REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C     OUTPUT ARGUMENTS--PTITTH
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.0)GOTO1199
      IF(IHARG(1).EQ.'THIC')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(NUMARG.EQ.1)GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PTITTH=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PTITTH=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)PTITTH
 1181 FORMAT('THE TITLE THICKNESS HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPTL(ICOM,IHARG,NUMARG,
     1IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL SWITCHES CONTAINED IN THE
C              4 VARIABLES IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
C              SUCH TIC LABEL SWITCHES TURN ON OR OFF
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1ZSW = LOWER HORIZONTAL TIC LABELS
C                     --IX2ZSW = UPPER HORIZONTAL TIC LABELS
C                     --IY1ZSW = LEFT  VERTICAL   TIC LABELS
C                     --IY2ZSW = RIGHT VERTICAL   TIC LABELS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IX1ZSW
      CHARACTER*4 IX2ZSW
      CHARACTER*4 IY1ZSW
      CHARACTER*4 IY2ZSW
C
      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
      IF(NUMARG.LE.0)GOTO1900
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO1900
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'NUMB')GOTO1900
C  FOLLOWING 4 LINES ADDED MAY, 1990.
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OFFS')GOTO1900
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'OFFS')GOTO1900
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'SIZE')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'HW')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'FORM')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'CONT')GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'NUMB')GOTO1900
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'COLO')GOTO1900
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'SIZE')GOTO1900
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'HW')GOTO1900
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FORM')GOTO1900
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CONT')GOTO1900
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'NUMB')GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1160
      GOTO1150
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZSW=IHOLD
      IX2ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1260
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1260
      GOTO1250
C
 1250 CONTINUE
      IHOLD='ON'
      GOTO1280
C
 1260 CONTINUE
      IHOLD='OFF'
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1360
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1360
      GOTO1350
C
 1350 CONTINUE
      IHOLD='ON'
      GOTO1380
C
 1360 CONTINUE
      IHOLD='OFF'
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1460
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1460
      GOTO1450
C
 1450 CONTINUE
      IHOLD='ON'
      GOTO1480
C
 1460 CONTINUE
      IHOLD='OFF'
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZSW=IHOLD
      IY2ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1560
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1560
      GOTO1550
C
 1550 CONTINUE
      IHOLD='ON'
      GOTO1580
C
 1560 CONTINUE
      IHOLD='OFF'
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1660
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1660
      GOTO1650
C
 1650 CONTINUE
      IHOLD='ON'
      GOTO1680
C
 1660 CONTINUE
      IHOLD='OFF'
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1760
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'LABE')GOTO1760
      GOTO1750
C
 1750 CONTINUE
      IHOLD='ON'
      GOTO1780
C
 1760 CONTINUE
      IHOLD='OFF'
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZSW=IHOLD
      IX2ZSW=IHOLD
      IY1ZSW=IHOLD
      IY2ZSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN TURNED ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLAN(ICOM,IHARG,ARG,NUMARG,
     1PDEFAN,
     1PX1ZAN,PX2ZAN,PY1ZAN,PY2ZAN,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL ANGLES CONTAINED IN THE
C              4 VARIABLES PX1ZAN,PX2ZAN,PY1ZAN,PY2ZAN
C              SUCH TIC LABEL ANGLES DEFINE THE ANGLES FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFAN
C     OUTPUT ARGUMENTS--
C                     --PX1ZAN = LOWER HORIZONTAL TIC LABEL ANGLE
C                     --PX2ZAN = UPPER HORIZONTAL TIC LABEL ANGLE
C                     --PY1ZAN = LEFT  VERTICAL   TIC LABEL ANGLE
C                     --PY2ZAN = RIGHT VERTICAL   TIC LABEL ANGLE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'ANGL')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'ANGL')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PHOLD=PDEFAN
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1ZAN=PHOLD
      PX2ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL ANGLE (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      PHOLD=PDEFAN
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX1ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      PHOLD=PDEFAN
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX2ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      PHOLD=PDEFAN
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1ZAN=PHOLD
      PY2ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL ANGLE (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      PHOLD=PDEFAN
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY1ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      PHOLD=PDEFAN
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY2ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL ANGLE (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'ANGL')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      PHOLD=PDEFAN
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1ZAN=PHOLD
      PX2ZAN=PHOLD
      PY1ZAN=PHOLD
      PY2ZAN=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL ANGLE (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLCA(ICOM,IHARG,NUMARG,
     1IDEFCA,
     1IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL CASES CONTAINED IN THE
C              4 VARIABLES IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
C              SUCH TIC LABEL CASES DEFINE THE CASES FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCA
C     OUTPUT ARGUMENTS--
C                     --IX1ZCA = LOWER HORIZONTAL TIC LABEL CASE
C                     --IX2ZCA = UPPER HORIZONTAL TIC LABEL CASE
C                     --IY1ZCA = LEFT  VERTICAL   TIC LABEL CASE
C                     --IY2ZCA = RIGHT VERTICAL   TIC LABEL CASE
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFCA
C
      CHARACTER*4 IX1ZCA
      CHARACTER*4 IX2ZCA
      CHARACTER*4 IY1ZCA
      CHARACTER*4 IY2ZCA
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'CASE')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CASE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCA
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZCA=IHOLD
      IX2ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL CASE (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCA
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL CASE (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCA
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL CASE (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCA
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZCA=IHOLD
      IY2ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL CASE (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCA
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL CASE (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCA
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL CASE (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'CASE')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCA
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZCA=IHOLD
      IX2ZCA=IHOLD
      IY1ZCA=IHOLD
      IY2ZCA=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL CASE (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL COLORS CONTAINED IN THE
C              4 VARIABLES IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
C              SUCH TIC LABEL COLORS DEFINE THE COLORS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C     OUTPUT ARGUMENTS--
C                     --IX1ZCO = LOWER HORIZONTAL TIC LABEL COLOR
C                     --IX2ZCO = UPPER HORIZONTAL TIC LABEL COLOR
C                     --IY1ZCO = LEFT  VERTICAL   TIC LABEL COLOR
C                     --IY2ZCO = RIGHT VERTICAL   TIC LABEL COLOR
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFCO
C
      CHARACTER*4 IX1ZCO
      CHARACTER*4 IX2ZCO
      CHARACTER*4 IY1ZCO
      CHARACTER*4 IY2ZCO
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'COLO')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'COLO')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZCO=IHOLD
      IX2ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL COLOR (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFCO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL COLOR (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFCO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL COLOR (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFCO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZCO=IHOLD
      IY2ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL COLOR (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFCO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL COLOR (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFCO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL COLOR (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'COLO')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFCO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZCO=IHOLD
      IX2ZCO=IHOLD
      IY1ZCO=IHOLD
      IY2ZCO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL COLOR (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLCN(ICOM,IHARG,NUMARG,
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC1IANS,IWIDTH,
     1IANS,IANSLC,IWIDTH,
     1IX1ZCN,IX2ZCN,IY1ZCN,IY2ZCN,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL CONTENTS CONTAINED IN THE
C              4 VARIABLES IX1ZCN,IX2ZCN,IY1ZCN,IY2ZCN
C              SUCH TIC LABEL CONTENTS DEFINE THE CONTENTS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --IX1ZCN = LOWER HORIZONTAL TIC LABEL CONTENTS
C                     --IX2ZCN = UPPER HORIZONTAL TIC LABEL CONTENTS
C                     --IY1ZCN = LEFT  VERTICAL   TIC LABEL CONTENTS
C                     --IY2ZCN = RIGHT VERTICAL   TIC LABEL CONTENTS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/2
C     ORIGINAL VERSION--JANUARY   1988.
C     UPDATED         --AUGUST    2001. UPDATE DIMENSIONS FROM 130
C                                       TO 160
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      CHARACTER*4 IANSLC
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*160 IHOLCN
      CHARACTER*160 ICJUNK
C
      CHARACTER*160 IX1ZCN
      CHARACTER*160 IX2ZCN
      CHARACTER*160 IY1ZCN
      CHARACTER*160 IY2ZCN
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
      DIMENSION IANS(*)
CCCCC THE FOLLOWING LINE WAS ADDED       SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
      DIMENSION IANSLC(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'CONT')GOTO1009
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'CONT')GOTO1009
      GOTO9000
 1009 CONTINUE
C
C               ************************************
C               **  EXTRACT THE FULL STRING       **
C               ************************************
C
      DO1010I=1,IWIDTH
      I2=I
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IP6=I+6
      IP7=I+7
      IF(IANS(I).EQ.'C'.AND.IANS(IP1).EQ.'O'
     1.AND.IANS(IP2).EQ.'N'.AND.IANS(IP3).EQ.'T'
     1.AND.IANS(IP4).EQ.'E'.AND.IANS(IP5).EQ.'N'
     1.AND.IANS(IP6).EQ.'T')
     1GOTO1019
 1010 CONTINUE
C
      WRITE(ICOUT,1011)
 1011 FORMAT('***** ERROR IN DPTLCN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      NO MATCH FOR COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1019 CONTINUE
      IFOUND='YES'
      ISTART=I2+8
      IF(IANS(IP7).EQ.'S')ISTART=I2+9
C
      ISTOP=0
      IF(ISTART.GT.IWIDTH)GOTO1039
      DO1030I=ISTART,IWIDTH
      IREV=IWIDTH-I+ISTART
      IF(IANS(IREV).NE.' ')GOTO1035
 1030 CONTINUE
      GOTO1039
 1035 CONTINUE
      ISTOP=IREV
 1039 CONTINUE
C
      ICJUNK(1:40)='                                        '
      ICJUNK(41:80)='                                        '
      ICJUNK(81:120)='                                        '
      ICJUNK(121:160)='                                        '
      IF(ISTART.GT.ISTOP)GOTO1049
      IF(ISTOP.EQ.0)GOTO1049
      J=0
      DO1040I=ISTART,ISTOP
      J=J+1
CCCCC THE FOLLOWING LINE WAS CHANGED     SEPTEMBER 1993
CCCCC TO ALLOW FOR LOWER CASE            SEPTEMBER 1993
CCCCC ICJUNK(J:J)=IANS(I)
      ICJUNK(J:J)=IANSLC(I)
 1040 CONTINUE
      NCJUNK=J
      GOTO1090
 1049 CONTINUE
      NCJUNK=0
      GOTO1090
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1180
C
 1160 CONTINUE
      IHOLCN=ICJUNK
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZCN=IHOLCN
      IX2ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,NCJUNK)
 1184   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1184)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1184)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1185)
 1185   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1189 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               ******************************************************
C               **  TREAT THE CASE WHEN                             **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE  **
C               **  CHANGED                                         **
C               ******************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1280
C
 1260 CONTINUE
      IHOLCN=ICJUNK
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1283)
 1283 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1284)(IHOLCN(I:I),I=1,NCJUNK)
 1284   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1284)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1284)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1285)
 1285   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1289 CONTINUE
      GOTO9000
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1380
C
 1360 CONTINUE
      IHOLCN=ICJUNK
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1383)
 1383 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1384)(IHOLCN(I:I),I=1,NCJUNK)
 1384   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1384)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1384)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1385)
 1385   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1389 CONTINUE
      GOTO9000
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1480
C
 1460 CONTINUE
      IHOLCN=ICJUNK
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZCN=IHOLCN
      IY2ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1483)
 1483 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1484)(IHOLCN(I:I),I=1,NCJUNK)
 1484   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1484)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1484)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1485)
 1485   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1489 CONTINUE
      GOTO9000
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1580
C
 1560 CONTINUE
      IHOLCN=ICJUNK
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)
 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1583)
 1583 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1584)(IHOLCN(I:I),I=1,NCJUNK)
 1584   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1584)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1584)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1585)
 1585   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1589 CONTINUE
      GOTO9000
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1680
C
 1660 CONTINUE
      IHOLCN=ICJUNK
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)
 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1683)
 1683 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1684)(IHOLCN(I:I),I=1,NCJUNK)
 1684   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1684)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1684)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1685)
 1685   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1689 CONTINUE
      GOTO9000
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'CONT')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLCN='DEFAULT'
      GOTO1780
C
 1760 CONTINUE
      IHOLCN=ICJUNK
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZCN=IHOLCN
      IX2ZCN=IHOLCN
      IY1ZCN=IHOLCN
      IY2ZCN=IHOLCN
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL CONTENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)
 1782 FORMAT('(FOR ALL 4 FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1783)
 1783 FORMAT('HAS JUST BEEN SET TO')
      CALL DPWRST('XXX','BUG ')
      IF(NCJUNK.GE.1.AND.NCJUNK.LE.80)THEN
        WRITE(ICOUT,1784)(IHOLCN(I:I),I=1,NCJUNK)
 1784   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.GE.81.AND.NCJUNK.LE.160)THEN
        WRITE(ICOUT,1784)(IHOLCN(I:I),I=1,80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1784)(IHOLCN(I:I),I=81,NCJUNK)
        CALL DPWRST('XXX','BUG ')
      ELSEIF(NCJUNK.LE.0)THEN
        WRITE(ICOUT,1785)
 1785   FORMAT('FLOAT WITH THE DATA.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
 1789 CONTINUE
      GOTO9000
C
 1799 CONTINUE
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLDI(ICOM,IHARG,NUMARG,
     1IDEFDI,
     1IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL DIRECTIONS CONTAINED IN THE
C              4 VARIABLES IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
C              SUCH TIC LABEL DIRECTIONS DEFINE THE DIRECTIONS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFDI
C     OUTPUT ARGUMENTS--
C                     --IX1ZDI = LOWER HORIZONTAL TIC LABEL DIRECTION
C                     --IX2ZDI = UPPER HORIZONTAL TIC LABEL DIRECTION
C                     --IY1ZDI = LEFT  VERTICAL   TIC LABEL DIRECTION
C                     --IY2ZDI = RIGHT VERTICAL   TIC LABEL DIRECTION
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFDI
C
      CHARACTER*4 IX1ZDI
      CHARACTER*4 IX2ZDI
      CHARACTER*4 IY1ZDI
      CHARACTER*4 IY2ZDI
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'DIRE')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'DIRE')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFDI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZDI=IHOLD
      IX2ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL DIRECTION (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFDI
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFDI
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFDI
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZDI=IHOLD
      IY2ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL DIRECTION (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFDI
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFDI
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL DIRECTION (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'DIRE')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFDI
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZDI=IHOLD
      IX2ZDI=IHOLD
      IY1ZDI=IHOLD
      IY2ZDI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL DIRECTION (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLDS(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHG,PDEFVG,
     1PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK LABEL DISPLACEMENT SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DEFINE THE DISPLACEMENT
C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFHG
C                     --PDEFVG
C     OUTPUT ARGUMENTS--
C                     --PX1ZDS,
C                     --PX2ZDS,
C                     --PY1ZDS,
C                     --PY2ZDS,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--91/9
C     ORIGINAL VERSION--AUGUST    1991.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'DISP')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'DISP')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'OFFS')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'OFFS')GOTO1090
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'GAP')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'GAP')GOTO1090
CCCCC GOTO1900
      GOTO9000
 1090 CONTINUE
      HOLD1=(-999.9)
      HOLD2=(-999.9)
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFHG
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1ZDS=HOLD1
      PX2ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL DISPLACEMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
 1183 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFHG
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX1ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)
 1282 FORMAT('(FOR THE BOTTOM HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFHG
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX2ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('(FOR THE TOP HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=PDEFVG
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1ZDS=HOLD1
      PY2ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)
 1482 FORMAT('(FOR BOTH VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=PDEFVG
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY1ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)
 1582 FORMAT('(FOR THE LEFT VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=PDEFVG
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY2ZDS=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)
 1682 FORMAT('(FOR THE RIGHT VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'DISP')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFHG
      HOLD2=PDEFVG
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1ZDS=HOLD1
      PX2ZDS=HOLD1
      PY1ZDS=HOLD2
      PY2ZDS=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)
 1782 FORMAT('(FOR BOTH HORIZONTAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD1
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1784)
 1784 FORMAT('(FOR BOTH VERTICAL   FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)HOLD2
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLFI(ICOM,IHARG,NUMARG,
     1IDEFFI,
     1IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL FILLS CONTAINED IN THE
C              4 VARIABLES IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
C              SUCH TIC LABEL FILLS DEFINE THE FILLS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFI
C     OUTPUT ARGUMENTS--
C                     --IX1ZFI = LOWER HORIZONTAL TIC LABEL FILL
C                     --IX2ZFI = UPPER HORIZONTAL TIC LABEL FILL
C                     --IY1ZFI = LEFT  VERTICAL   TIC LABEL FILL
C                     --IY2ZFI = RIGHT VERTICAL   TIC LABEL FILL
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFFI
C
      CHARACTER*4 IX1ZFI
      CHARACTER*4 IX2ZFI
      CHARACTER*4 IY1ZFI
      CHARACTER*4 IY2ZFI
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'FILL')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FILL')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFFI
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZFI=IHOLD
      IX2ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL FILL (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFFI
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL FILL (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFFI
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL FILL (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFFI
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZFI=IHOLD
      IY2ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL FILL (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFFI
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL FILL (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFFI
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL FILL (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'FILL')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFFI
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZFI=IHOLD
      IX2ZFI=IHOLD
      IY1ZFI=IHOLD
      IY2ZFI=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL FILL (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLFM(ICOM,IHARG,NUMARG,
     1IDETLF,
     1IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL FORMATS CONTAINED IN THE
C              4 VARIABLES IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM
C              SUCH TIC LABEL FORMATS DEFINE THE FORMATS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDETLF
C     OUTPUT ARGUMENTS--
C                     --IX1ZFM = LOWER HORIZONTAL TIC LABEL FORMAT
C                     --IX2ZFM = UPPER HORIZONTAL TIC LABEL FORMAT
C                     --IY1ZFM = LEFT  VERTICAL   TIC LABEL FORMAT
C                     --IY2ZFM = RIGHT VERTICAL   TIC LABEL FORMAT
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/2
C     ORIGINAL VERSION--FEBRUARY  1988.
C     UPDATED         --JANUARY   2004. ADD SUPPORT FOR:
C                                       ROW LABEL
C                                       GROUP LABEL
C                                       VARIABLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDETLF
C
      CHARACTER*4 IX1ZFM
      CHARACTER*4 IX2ZFM
      CHARACTER*4 IY1ZFM
      CHARACTER*4 IY2ZFM
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'FORM')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FORM')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1150
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1170
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1170
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1172
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1174
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDETLF
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1180
C
 1170 CONTINUE
      IHOLD='ROWL'
      GOTO1180
C
 1172 CONTINUE
      IHOLD='GLAB'
      GOTO1180
C
 1174 CONTINUE
      IHOLD='VARI'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZFM=IHOLD
      IX2ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL FORMAT (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1250
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1270
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1270
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1272
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1274
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDETLF
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1280
C
 1270 CONTINUE
      IHOLD='ROWL'
      GOTO1280
C
 1272 CONTINUE
      IHOLD='GLAB'
      GOTO1280
C
 1274 CONTINUE
      IHOLD='VARI'
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL FORMAT (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1350
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1370
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1370
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1372
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1374
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDETLF
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1380
C
 1370 CONTINUE
      IHOLD='ROWL'
      GOTO1380
C
 1372 CONTINUE
      IHOLD='GLAB'
      GOTO1380
C
 1374 CONTINUE
      IHOLD='VARI'
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL FORMAT (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1450
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1470
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1470
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1472
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1474
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDETLF
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1480
C
 1470 CONTINUE
      IHOLD='ROWL'
      GOTO1480
C
 1472 CONTINUE
      IHOLD='GLAB'
      GOTO1480
C
 1474 CONTINUE
      IHOLD='VARI'
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZFM=IHOLD
      IY2ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL FORMAT (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1550
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1570
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1570
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1572
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1574
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDETLF
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1580
C
 1570 CONTINUE
      IHOLD='ROWL'
      GOTO1580
C
 1572 CONTINUE
      IHOLD='GLAB'
      GOTO1580
C
 1574 CONTINUE
      IHOLD='VARI'
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL FORMAT (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1650
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1670
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1670
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1672
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1674
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDETLF
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1680
C
 1670 CONTINUE
      IHOLD='ROWL'
      GOTO1680
C
 1672 CONTINUE
      IHOLD='GLAB'
      GOTO1680
C
 1674 CONTINUE
      IHOLD='VARI'
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL FORMAT (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'FORM')GOTO1750
      IF(IHARG(NUMARG).EQ.'ROWL')GOTO1770
      IF(IHARG(NUMARG-1).EQ.'ROW '.AND.IHARG(NUMARG).EQ.'LABE')GOTO1770
      IF(IHARG(NUMARG-1).EQ.'GROU'.AND.IHARG(NUMARG).EQ.'LABE')GOTO1772
      IF(IHARG(NUMARG).EQ.'VARI')GOTO1774
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDETLF
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      IF(IHOLD.EQ.'FIXE')IHOLD='REAL'
      GOTO1780
C
 1770 CONTINUE
      IHOLD='ROWL'
      GOTO1180
C
 1772 CONTINUE
      IHOLD='GLAB'
      GOTO1180
C
 1774 CONTINUE
      IHOLD='VARI'
      GOTO1180
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZFM=IHOLD
      IX2ZFM=IHOLD
      IY1ZFM=IHOLD
      IY2ZFM=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL FORMAT (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLFO(ICOM,IHARG,NUMARG,
     1IDEFFO,
     1IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL FONTS CONTAINED IN THE
C              4 VARIABLES IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
C              SUCH TIC LABEL FONTS DEFINE THE FONTS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFFO
C     OUTPUT ARGUMENTS--
C                     --IX1ZFO = LOWER HORIZONTAL TIC LABEL FONT
C                     --IX2ZFO = UPPER HORIZONTAL TIC LABEL FONT
C                     --IY1ZFO = LEFT  VERTICAL   TIC LABEL FONT
C                     --IY2ZFO = RIGHT VERTICAL   TIC LABEL FONT
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFFO
C
      CHARACTER*4 IX1ZFO
      CHARACTER*4 IX2ZFO
      CHARACTER*4 IY1ZFO
      CHARACTER*4 IY2ZFO
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'FONT')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'FONT')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFFO
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZFO=IHOLD
      IX2ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL FONT (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFFO
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL FONT (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFFO
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL FONT (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFFO
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZFO=IHOLD
      IY2ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL FONT (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFFO
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL FONT (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFFO
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL FONT (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'FONT')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFFO
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZFO=IHOLD
      IX2ZFO=IHOLD
      IY1ZFO=IHOLD
      IY2ZFO=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL FONT (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLHW(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK LABEL HEIGHT AND WIDTH SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DEFINE THE HEIGHT AND WIDTH
C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFHE
C                     --PDEFWI
C     OUTPUT ARGUMENTS--
C                     --PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
C                     --PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
C                     --PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
C                     --PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JULY      1987.
C     UPDATED         --DECEMBER  1988.    ADD DEFAULT WIDTH
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMAM1=NUMARG-1
C
CCCCC IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'HW')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'HW')GOTO1090
CCCCC GOTO1900
      GOTO9000
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'HW')GOTO1150
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX2ZHE=HOLD1
      PX1ZWI=HOLD2
      PX2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR BOTH ',
     1'HORIZONTAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD1,HOLD2
 1182 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'HW')GOTO1250
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX1ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD1,HOLD2
 1282 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'HW')GOTO1350
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX2ZHE=HOLD1
      PX2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE TOP ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD1,HOLD2
 1382 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'HW')GOTO1450
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1ZHE=HOLD1
      PY2ZHE=HOLD1
      PY1ZWI=HOLD2
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR BOTH ',
     1'VERTICAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD1,HOLD2
 1482 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'HW')GOTO1550
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY1ZHE=HOLD1
      PY1ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE LEFT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD1,HOLD2
 1582 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'HW')GOTO1650
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY2ZHE=HOLD1
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR THE RIGHT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD1,HOLD2
 1682 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'HW')GOTO1750
      IF(IARGT(NUMAM1).EQ.'NUMB'.AND.
     1   IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX2ZHE=HOLD1
      PY1ZHE=HOLD1
      PY2ZHE=HOLD1
      PX1ZWI=HOLD2
      PX2ZWI=HOLD2
      PY1ZWI=HOLD2
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL HEIGHT & WIDTH (FOR ',
     1'ALL 4 FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD1,HOLD2
 1782 FORMAT('HAVE JUST BEEN SET TO ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
      PX1ZVG=PX1ZHE*0.375
      PX2ZVG=PX2ZHE*0.375
      PY1ZVG=PY1ZHE*0.375
      PY2ZVG=PY2ZHE*0.375
C
      PX1ZHG=PX1ZHE*0.125
      PX2ZHG=PX2ZHE*0.125
      PY1ZHG=PY1ZHE*0.125
      PY2ZHG=PY2ZHE*0.125
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLJU(ICOM,IHARG,NUMARG,
     1IDEFJU,
     1IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL JUSTIFICATIONS CONTAINED IN THE
C              4 VARIABLES IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
C              SUCH TIC LABEL JUSTIFICATIONS DEFINE THE JUSTIFICATIONS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFJU
C     OUTPUT ARGUMENTS--
C                     --IX1ZJU = LOWER HORIZONTAL TIC LABEL JUSTIFICATION
C                     --IX2ZJU = UPPER HORIZONTAL TIC LABEL JUSTIFICATION
C                     --IY1ZJU = LEFT  VERTICAL   TIC LABEL JUSTIFICATION
C                     --IY2ZJU = RIGHT VERTICAL   TIC LABEL JUSTIFICATION
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
      CHARACTER*4 IDEFJU
C
      CHARACTER*4 IX1ZJU
      CHARACTER*4 IX2ZJU
      CHARACTER*4 IY1ZJU
      CHARACTER*4 IY2ZJU
C
      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
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'JUST')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'JUST')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFJU
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IX1ZJU=IHOLD
      IX2ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR BOTH ',
     1'HORIZONTAL FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)IHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      IHOLD=IDEFJU
      GOTO1280
C
 1260 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IX1ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE BOTTOM ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)IHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      IHOLD=IDEFJU
      GOTO1380
C
 1360 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IX2ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE TOP ',
     1'HORIZONTAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)IHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      IHOLD=IDEFJU
      GOTO1480
C
 1460 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      IY1ZJU=IHOLD
      IY2ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)IHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      IHOLD=IDEFJU
      GOTO1580
C
 1560 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      IY1ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE LEFT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)IHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      IHOLD=IDEFJU
      GOTO1680
C
 1660 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      IY2ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR THE RIGHT ',
     1'VERTICAL FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)IHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'JUST')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      IHOLD=IDEFJU
      GOTO1780
C
 1760 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      IX1ZJU=IHOLD
      IX2ZJU=IHOLD
      IY1ZJU=IHOLD
      IY2ZJU=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL JUSTIFICATION (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)IHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TIC MARK LABEL SIZE SWITCHES
C              FOR ANY OF THE 4 FRAME LINES.
C              SUCH TIC MARK SWITCHES DEFINE THE SIZE (HEIGHT)
C              OF THE TIC MARK LABELS ON THE 4 FRAME LINES OF A PLOT.
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --PDEFHE
C     OUTPUT ARGUMENTS--
C                     --PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
C                     --PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
C                     --PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
C                     --PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1988.  DEFAULT WIDTH
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'SIZE')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'SIZE')GOTO1090
CCCCC GOTO1900
      GOTO9000
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      IERROR='YES'
      GOTO9000
C
 1150 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX2ZHE=HOLD1
      PX1ZWI=HOLD2
      PX2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL SIZE (FOR BOTH HORIZONTAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)HOLD1
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1250
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1260
      IERROR='YES'
      GOTO9000
C
 1250 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1280
C
 1260 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX1ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL SIZE (FOR THE BOTTOM HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)HOLD1
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1350
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1360
      IERROR='YES'
      GOTO9000
C
 1350 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1380
C
 1360 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PX2ZHE=HOLD1
      PX2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL SIZE (FOR THE TOP HORIZONTAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)HOLD1
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1450
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1460
      IERROR='YES'
      GOTO9000
C
 1450 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1480
C
 1460 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PY1ZHE=HOLD1
      PY2ZHE=HOLD1
      PY1ZWI=HOLD2
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL SIZE (FOR BOTH VERTICAL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)HOLD1
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1550
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1560
      IERROR='YES'
      GOTO9000
C
 1550 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1580
C
 1560 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PY1ZHE=HOLD1
      PY1ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL SIZE (FOR THE LEFT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)HOLD1
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1650
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1660
      IERROR='YES'
      GOTO9000
C
 1650 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1680
C
 1660 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PY2ZHE=HOLD1
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL SIZE (FOR THE RIGHT VERTICAL ',
     1'FRAME LINE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)HOLD1
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'SIZE')GOTO1750
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1760
      IERROR='YES'
      GOTO9000
C
 1750 CONTINUE
      HOLD1=PDEFHE
      HOLD2=PDEFWI
      GOTO1780
C
 1760 CONTINUE
      HOLD1=ARG(NUMARG)
      HOLD2=HOLD1*0.5
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PX1ZHE=HOLD1
      PX2ZHE=HOLD1
      PY1ZHE=HOLD1
      PY2ZHE=HOLD1
      PX1ZWI=HOLD2
      PX2ZWI=HOLD2
      PY1ZWI=HOLD2
      PY2ZWI=HOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL SIZE (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)HOLD1
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
C
      PX1ZVG=PX1ZHE*0.375
      PX2ZVG=PX2ZHE*0.375
      PY1ZVG=PY1ZHE*0.375
      PY2ZVG=PY2ZHE*0.375
C
      PX1ZHG=PX1ZHE*0.125
      PX2ZHG=PX2ZHE*0.125
      PY1ZHG=PY1ZHE*0.125
      PY2ZHG=PY2ZHE*0.125
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPTLTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PTIZTH,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 4 TIC LABEL THICKNESSS CONTAINED IN THE
C              4 VARIABLES PTIZTH,PTIZTH,PTIZTH,PTIZTH
C              SUCH TIC LABEL THICKNESSS DEFINE THE THICKNESSS FOR
C              THE TIC LABELS ON THE 4 FRAME LINES OF A PLOT.
C              NOTE: ALL 4 THICKNESS CURRENTLY LIMITED TO ONE
C                    SETTING, PTIZTH
C     INPUT  ARGUMENTS--ICOM
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C     OUTPUT ARGUMENTS--
C                     --PTIZTH = LOWER HORIZONTAL TIC LABEL THICKNESS
C                     --PTIZTH = UPPER HORIZONTAL TIC LABEL THICKNESS
C                     --PTIZTH = LEFT  VERTICAL   TIC LABEL THICKNESS
C                     --PTIZTH = RIGHT VERTICAL   TIC LABEL THICKNESS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
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--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
C
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1900
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LABE'.AND.
     1IHARG(2).EQ.'THIC')GOTO1090
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MARK'.AND.
     1IHARG(2).EQ.'LABE'.AND.IHARG(3).EQ.'THIC')GOTO1090
      GOTO1900
 1090 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH HORIZONTAL AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1160 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)PHOLD
 1182 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1199 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE BOTTOM HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X1TI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1250
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1250
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1250
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1250
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1250
      GOTO1260
C
 1250 CONTINUE
      PHOLD=PDEFTH
      GOTO1280
C
 1260 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1281)
 1281 FORMAT('THE TIC MARK LABEL THICKNESS (ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1282)PHOLD
 1282 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1299 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE TOP    HORIZONTAL TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'X2TI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1350
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1350
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1350
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1350
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1350
      GOTO1360
C
 1350 CONTINUE
      PHOLD=PDEFTH
      GOTO1380
C
 1360 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)PHOLD
 1382 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1399 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  BOTH VERTICAL   AXIS TICS ARE TO BE CHANGED    **
C               *****************************************************
C
      IF(ICOM.EQ.'YTIC')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1450
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1450
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1450
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1450
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1450
      GOTO1460
C
 1450 CONTINUE
      PHOLD=PDEFTH
      GOTO1480
C
 1460 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1480
C
 1480 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1489
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1481)
 1481 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1482)PHOLD
 1482 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1489 CONTINUE
      GOTO1900
C
 1499 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE LEFT   VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y1TI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1550
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1550
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1550
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1550
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1550
      GOTO1560
C
 1550 CONTINUE
      PHOLD=PDEFTH
      GOTO1580
C
 1560 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1580
C
 1580 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1581)
 1581 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1582)PHOLD
 1582 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1589 CONTINUE
      GOTO1900
C
 1599 CONTINUE
C
C               **************************************************************
C               **  TREAT THE CASE WHEN                                     **
C               **  ONLY THE RIGHT  VERTICAL   TIC MARKS ARE TO BE CHANGED  **
C               **************************************************************
C
      IF(ICOM.EQ.'Y2TI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1650
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1650
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1650
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1650
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1650
      GOTO1660
C
 1650 CONTINUE
      PHOLD=PDEFTH
      GOTO1680
C
 1660 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1680
C
 1680 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1689
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1681)
 1681 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1682)PHOLD
 1682 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1689 CONTINUE
      GOTO1900
C
 1699 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  ALL 4 FRAME TICS ARE TO BE CHANGED             **
C               *****************************************************
C
      IF(ICOM.EQ.'TIC')GOTO1700
      IF(ICOM.EQ.'TICS')GOTO1700
      IF(ICOM.EQ.'XYTI')GOTO1700
      IF(ICOM.EQ.'YXTI')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1750
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1750
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1750
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1750
      IF(IHARG(NUMARG).EQ.'THIC')GOTO1750
      GOTO1760
C
 1750 CONTINUE
      PHOLD=PDEFTH
      GOTO1780
C
 1760 CONTINUE
      PHOLD=ARG(NUMARG)
      GOTO1780
C
 1780 CONTINUE
      IFOUND='YES'
      PTIZTH=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1789
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1781)
 1781 FORMAT('THE TIC MARK LABEL THICKNESS (FOR ALL 4 ',
     1'FRAME LINES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1782)PHOLD
 1782 FORMAT('HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1789 CONTINUE
      GOTO1900
C
 1799 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTMCO(XTEMP1,XTEMP2,MAXNXT,ICASAN,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE CONFIDENCE LIMITS FOR THE TRIMMED MEAN
C              FOR PROBABILITY VALUE P = .90, .95, .99, .999, AND .9999.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     REFERENCE--"INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
C                TESTING", RAND R. WILCOX, ACADEMIC PRESS, 1997.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C     UPDATED         --OCTOBERY  2003. ADD SUPPORT FOR HTML, LATEX
C                                       OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTM'
      ISUBN2='CO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=5
C
      IFOUND='YES'
C
      NLEFT=0
      N2=0
C
      ICASEQ='UNKN'
C
C     *****************************************************
C     **  TREAT THE TRIMMED MEAN CONFIDENCE LIMITS CASE  **
C     *****************************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTMCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)ICASAN
   57 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C     *******************************************************
C     **  STEP 2--                                         **
C     **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C     *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C     ********************************************
C     **  STEP 3--                              **
C     **  CHECK THE VALIDITY OF ARGUMENT 1      **
C     **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C     ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C     ******************************************************
C     **  STEP 4--                                        **
C     **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C     **  (NLEFT) FOR THE RESPONSE VARIABLE IS 2 OR MORE. **
C     ******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPTMCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FROM WHICH TRIMMED MEAN CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WERE TO HAVE BEEN CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,MAX(IWIDTH,80))
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C     *****************************************
C     **  STEP 5--                           **
C     **  CHECK TO SEE THE TYPE CASE--       **
C     **    1) UNQUALIFIED (THAT IS, FULL);  **
C     **    2) SUBSET/EXCEPT; OR             **
C     **    3) FOR.                          **
C     *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'ON')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C     *********************************************
C     **  STEP 5--                               **
C     **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C     **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C     **  FORM THIS VARIABLE BY                  **
C     **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C     **  (FULL, SUBSET, OR FOR).                **
C     *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,MAX(NLEFT,N2)
      ISUB(I)=1
  515 CONTINUE
      NQ=MAX(NLEFT,N2)
      GOTO550
C
  520 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=MAX(NLEFT,N2)
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPTMCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH TRIMMED MEAN CONFIDENCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      ARE TO BE CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,MAX(IWIDTH,80))
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C     ******************************************************
C     **  STEP 8--
C     **  PREPARE FOR ENTRANCE INTO DPTMC2--
C     **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C     ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C     ******************************************************
C     **  STEP 9--                                        **
C     **  DETERMINE VALUE OF TRIMMING CONSTANTS (OBTAINED **
C     **  FROM PARAMETERS P1 AND P2)                      **
C     ******************************************************
C
      IHP='P1  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP1=VALUE(ILOCP)
C
      IHP='P2  '
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      PROP2=VALUE(ILOCP)
C
      IF(0.0.LE.PROP1.AND.PROP1.LE.100.0)GOTO11589
      IF(0.0.LE.PROP2.AND.PROP2.LE.100.0)GOTO11589
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11581)
11581 FORMAT('***** ERROR IN DPTMCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11582)
11582 FORMAT('THE PROPORTION TO BE TRIMMED BELOW AND ABOVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11583)
11583 FORMAT('MUST BE BETWEEN 0 AND 100, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11584)PROP1
11584 FORMAT('PARAMETER P1 = LOWER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11585)PROP2
11585 FORMAT('PARAMETER P2 = UPPER PROPORTION = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11586)
11586 FORMAT('USE THE LET COMMAND TO PRE-DEFINE P1 AND P2, AS IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11587)
11587 FORMAT('      LET P1 = 25')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11588)
11588 FORMAT('      LET P2 = 10')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
11589 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE CONFIDENCE LIMITS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPTMCO, AS WE ARE ABOUT TO CALL DPTMC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPTMC2(Y,W,NS,X,NS2,XTEMP1,XTEMP2,MAXNXT,
     1PROP1,PROP2,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C     *****************
C     **  STEP 90--  **
C     **  EXIT       **
C     *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TMCO')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTMCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPTMC2(Y,W,N,X,N2,XTEMP1,XTEMP2,MAXNXT,
     1PROP1,PROP2,
     1ICAPSW,ICAPTY,
     1ICASAN,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE GENERATES TRIMMED MEAN CONFIDENCE LIMITS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     NOTE--ASSUMPTION--MODEL IS   RESPONSE = CONSTANT + ERROR.
C     NOTE--WEIGHTS AND TWO VARIABLE (=DIFFERENCE OF TWO MEANS)
C           NOT YET SUPPORTED.  ARGUMENTS PASSED FOR POSSIBLE
C           FUTURE IMPLEMENTATION.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF OBSERVATIONS
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C     ORIGINAL VERSION--OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX
C                                       OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ICASAN
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBASLC
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION W(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION CONF(10)
      DIMENSION T(10)
      DIMENSION TSDM(10)
      DIMENSION ALOWER(10)
      DIMENSION AUPPER(10)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTM'
      ISUBN2='C2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPTMC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)N,PROP1,PROP2,IBUGA3
   52 FORMAT('N,PROP1,PROP2,IBUGA3 = ',I8,2X,E15.7,2X,E15.7,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),W(I),X(I)
   57 FORMAT('I,Y(I),W(I),X(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,58)ICASAN
   58 FORMAT('ICASAN   = ',A4)
      CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.5)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPTMC2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS LESS THAN 5')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPTMC2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
  139 CONTINUE
C
C               ***************************************************
C               **  STEP 3--                                     **
C               **  COMPUTE THE TRIMMED MEAN LOCATION ESTIMATE   **
C               **  COMPUTE THE TRIMMED MEAN STANDARD ERROR      **
C               ***************************************************
C
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL TRIMME(Y,N,PROP1,PROP2,IWRITE,XTEMP1,MAXNXT,YTRMME,
     1IBUGA3,IERROR)
      CALL TRIMSE(Y,N,PROP1,PROP2,IWRITE,XTEMP1,XTEMP2,MAXNXT,YTRMSE,
     1IBUGA3,IERROR)
C
      AN1=N
      LAMBDA=INT(AN1*(PROP1+PROP2)/100.)
      V=0.7*(AN1-1.0)
      IV=N - LAMBDA - 1
      IF(IV.LT.1)IV=1
C
C               ***************************************
C               **  STEP 4--                         **
C               **  COMPUTE CONFIDENCE LIMITS        **
C               **  FOR VARIOUS PROBABILITY VALUES.  **
C               ***************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CONF(1)=50.0
      CONF(2)=75.0
      CONF(3)=90.0
      CONF(4)=95.0
      CONF(5)=99.0
      CONF(6)=99.9
      CONF(7)=99.99
      CONF(8)=99.999
C
      DO1400I=1,8
        PCONF=CONF(I)/100.0
        CDF=0.5+PCONF/2.0
        CALL TPPF(CDF,IV,T(I))
        TSDM(I)=T(I)*YTRMSE
        ALOWER(I)=YTRMME-TSDM(I)
        AUPPER(I)=YTRMME+TSDM(I)
 1400 CONTINUE
C
C               ****************************
C               **  STEP 7--              **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
CCCCC OCTOBER 2003: WRITE OUTPUT IN HTML FORMAT
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
 5004   FORMAT('<BR><BR>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>Confidence Limits for the Trimmed Mean ',
     1         'Location<BR>')
 5018   FORMAT('      (2-Sided)</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5018)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=200>')
 5045   FORMAT('         Number of Observations:')
 5047   FORMAT('      </TD>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5031   FORMAT('         ',G15.7)
 5033   FORMAT('         ',I8)
 5039   FORMAT('   </TR>')
 5051   FORMAT('         Trimmed Mean Location:')
 5052   FORMAT('         Standard Error:')
 5053   FORMAT('         Degrees of Freedom:')
 5054   FORMAT('         Percentage Trimmed Below:')
 5055   FORMAT('         Percentage Trimmed Above:')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5045)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5033)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5054)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)PROP1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5055)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)PROP2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)YTRMME
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5031)YTRMSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5053)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5033)IV
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5099   FORMAT('<PRE>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5131   FORMAT('         Confidence<BR>Value (%)')
 5132   FORMAT('         t<BR>Value')
 5133   FORMAT('         t X Standard Error)')
 5134   FORMAT('         Lower<br>Limit')
 5135   FORMAT('         Upper<br>Limit')
 5161   FORMAT('      <TD COLSPAN=5>')
 5162   FORMAT('          <HR>')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   <TR>')
 5143   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM WIDTH=150>')
 5147   FORMAT('      </TD>')
 5151   FORMAT('         ',F8.3)
 5152   FORMAT('         ',G12.6)
 5149   FORMAT('   </TR>')
        DO5180I=1,8
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)T(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)TSDM(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)ALOWER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)AUPPER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
 5180   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
 5199   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Confidence Limits for the Trimmed Mean ',
     1      'Location (2-Sided)}')
 8013 FORMAT(A1,'end{center}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8022 FORMAT(5X,'Trimmed Mean Location: & ',G15.7,2X,A1,A1)
 8024 FORMAT(5X,'Standard Error: & ',G15.7,2X,A1,A1)
 8025 FORMAT(5X,'Degrees of Freedom: & ',I8,2X,A1,A1)
 8026 FORMAT(5X,'Percetage Trimmed Below: & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Percetage Trimmed Above: & ',G15.7,2X,A1,A1)
 8049 FORMAT(5X,A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)PROP1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)PROP2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)YTRMME,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)YTRMSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)IV,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{table}')
 8093 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120 FORMAT(5X,A1,'begin{tabular} {ccccc}')
 8121 FORMAT(5X,'{',A1,'bf Confidence} & {',A1,'bf t } & & ',
     1       '{',A1,'bf Lower } & {',A1,'bf Upper}',2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Value (',A1,'%) } & {',A1,'bf Value} & {',A1,
     1       'bf t x Standard Error} & {',A1,'bf Limit} & {',A1,
     1       'bf Limit }',2X,A1,A1)
 8123 FORMAT(5X,2(F8.3,' & '),2(G12.6,' & '),G12.6,2X,A1,A1)
 8130 FORMAT(5X,A1,'hline')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,IBASLC,
     1                   IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8130)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO8160I=1,8
          WRITE(ICOUT,8123)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I),
     1                     IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
 8160   CONTINUE
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C PLACEHOLDER FOR RTF FORMAT OUTPUT
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,811)
  811   FORMAT(
     1'                   CONFIDENCE LIMITS FOR TRIMMED MEAN LOCATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,812)
  812   FORMAT(
     1'                           (2-SIDED)')
        CALL DPWRST('XXX','WRIT')
 
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,815)N
  815   FORMAT(
     1'          NUMBER OF OBSERVATIONS         = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,817)PROP1
  817   FORMAT(
     1'          PERCENTAGE TRIMMED BELOW       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,818)PROP2
  818   FORMAT(
     1'          PERCENTAGE TRIMMED ABOVE       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,822)YTRMME
  822   FORMAT(
     1'          TRIMMED MEAN LOCATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,823)YTRMSE
  823   FORMAT(
     1'          TRIMMED MEAN STANDARD ERROR    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,826)IV
  826   FORMAT(
     1'          DEGREES OF FREEDOM             = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,832)
  832   FORMAT(
     1'   CONFIDENCE   T     T X STDERR       LOWER         UPPER     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,833)
  833   FORMAT(
     1'   VALUE (%)  VALUE                    LIMIT         LIMIT     ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,834)
  834   FORMAT(
     1'---------------------------------------------------------------')
        CALL DPWRST('XXX','WRIT')
        DO840I=1,8
          WRITE(ICOUT,841)CONF(I),T(I),TSDM(I),ALOWER(I),AUPPER(I)
  841     FORMAT(
     1'   ',F8.3,F8.3,2X,G12.6,2X,G12.6,2X,G12.6)
          CALL DPWRST('XXX','WRIT')
  840   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TMC2')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTMC2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPTOLI(XTEMP1,XTEMP2,MAXNXT,
     1ICASAN,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE TOLERANCE LIMITS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCO'
      ISUBN2='NF  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ***************************************
C               **  TREAT THE TOLERANCE LIMITS CASE  **
C               ***************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTOLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.          **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPTOLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FROM WHICH TOLERANCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WERE TO HAVE BEEN CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPTOLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH TOLERANCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      ARE TO BE CALCULATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               *******************************************************
C               **  STEP 8--                                         **
C               **  PREPARE FOR ENTRANCE INTO TOL   --               **
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.       **
C               *******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE TOLERANCE LIMITS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPTOLI, AS WE ARE ABOUT TO CALL TOL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL TOL(Y,NS,ICASAN)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTOLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTPCO(IHARG,NUMARG,IDETPC,MAXTEX,ITEPCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT PATTERN COLORS = THE COLORS
C              OF THE LINES MAKING UP A PATTERN WITHIN A TEXT.
C              THESE ARE LOCATED IN THE VECTOR ITEPCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETPC
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEPCO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDETPC
      CHARACTER*4 ITEPCO
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ITEPCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTP'
      ISUBN2='CO  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETPC
   55 FORMAT('IDETPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEPCO(1)
   70 FORMAT('ITEPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEPCO(I)
   76 FORMAT('I,ITEPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEPCO(1)=IDETPC
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPC
      ITEPCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEPCO(I)
 1276 FORMAT('THE COLOR OF TEXT PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPC
      DO1315I=1,NUMTEX
      ITEPCO(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEPCO(I)
 1316 FORMAT('THE COLOR OF ALL TEXT PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTPCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETPC
 9015 FORMAT('IDETPC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEPCO(1)
 9030 FORMAT('ITEPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEPCO(I)
 9036 FORMAT('I,ITEPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTPLI(IHARG,IHARG2,NUMARG,IDETPL,MAXTEX,ITEPLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCC  SUBROUTINE DPTPLI(IHARG,NUMARG,IDETPL,MAXTEX,ITEPLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN LINES = THE LINES TYPES
C              OF THE PATTERN WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEPLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETPL
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEPLI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDETPL
      CHARACTER*4 ITEPLI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION ITEPLI(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTP'
      ISUBN2='LI  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETPL
   55 FORMAT('IDETPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEPLI(1)
   70 FORMAT('ITEPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEPLI(I)
   76 FORMAT('I,ITEPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEPLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-3
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPL
      ITEPLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEPLI(I)
 1276 FORMAT('THE LINE TYPE FOR TEXT PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPL
      DO1315I=1,NUMTEX
      ITEPLI(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEPLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL TEXT PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTPLI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETPL
 9015 FORMAT('IDETPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEPLI(1)
 9030 FORMAT('ITEPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEPLI(I)
 9036 FORMAT('I,ITEPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTPSP(IHARG,IARGT,ARG,NUMARG,PDETPS,MAXTEX,PTEPSP,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT PATTERN SPACINGS = THE SPACINGS
C              BETWEEN THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR PTEPSP(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDETPS
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PTEPSP (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PTEPSP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTP'
      ISUBN2='SP  '
C
      NUMTEX=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDETPS
   55 FORMAT('PDETPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PTEPSP(1)
   70 FORMAT('PTEPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PTEPSP(I)
   76 FORMAT('I,PTEPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDETPS
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      PTEPSP(1)=PDETPS
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPS
      PTEPSP(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,PTEPSP(I)
 1276 FORMAT('THE SPACING BETWEEN (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPS
      DO1315I=1,NUMTEX
      PTEPSP(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PTEPSP(I)
 1316 FORMAT('THE SPACING BETWEEN (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDETPS
 9015 FORMAT('PDETPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PTEPSP(1)
 9030 FORMAT('PTEPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PTEPSP(I)
 9036 FORMAT('I,PTEPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTPTH(IHARG,IARGT,ARG,NUMARG,PDETPT,MAXTEX,PTEPTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE TEXT PATTERN THICKNESSES = THE THICKNESSES
C              OF THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR PTEPTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDETPT
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PTEPTH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PTEPTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTP'
      ISUBN2='TH  '
C
      NUMTEX=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDETPT
   55 FORMAT('PDETPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PTEPTH(1)
   70 FORMAT('PTEPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PTEPTH(I)
   76 FORMAT('I,PTEPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDETPT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      PTEPTH(1)=PDETPT
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPT
      PTEPTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,PTEPTH(I)
 1276 FORMAT('THE THICKNESS OF (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDETPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDETPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDETPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDETPT
      DO1315I=1,NUMTEX
      PTEPTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PTEPTH(I)
 1316 FORMAT('THE THICKNESS OF (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTPTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDETPT
 9015 FORMAT('PDETPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PTEPTH(1)
 9030 FORMAT('PTEPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PTEPTH(I)
 9036 FORMAT('I,PTEPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTPTY(IHARG,NUMARG,IDETPT,MAXTEX,ITEPTY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN TYPES = THE TYPES
C              OF THE PATTERN WITHIN THE TEXTS.
C              THESE ARE LOCATED IN THE VECTOR ITEPTY(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDETPT
C                     --MAXTEX
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ITEPTY (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDETPT
      CHARACTER*4 ITEPTY
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ITEPTY(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPTP'
      ISUBN2='TY  '
C
      NUMTEX=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXTEX,NUMTEX
   53 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDETPT
   55 FORMAT('IDETPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ITEPTY(1)
   70 FORMAT('ITEPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ITEPTY(I)
   76 FORMAT('I,ITEPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMTEX=1
      ITEPTY(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMTEX=NUMARG-2
      IF(NUMTEX.GT.MAXTEX)NUMTEX=MAXTEX
      DO1225I=1,NUMTEX
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPT
      ITEPTY(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMTEX
      WRITE(ICOUT,1276)I,ITEPTY(I)
 1276 FORMAT('THE TYPE FOR TEXT PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMTEX=MAXTEX
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDETPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDETPT
      DO1315I=1,NUMTEX
      ITEPTY(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ITEPTY(I)
 1316 FORMAT('THE TYPE FOR ALL TEXT PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTPTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXTEX,NUMTEX
 9013 FORMAT('MAXTEX,NUMTEX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDETPT
 9015 FORMAT('IDETPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ITEPTY(1)
 9030 FORMAT('ITEPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ITEPTY(I)
 9036 FORMAT('I,ITEPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTREN(XTEMP1,XTEMP2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT 3 TRENDS TEST FOR RELIABILITY ANALYSIS.
C              1) REVERSE ARRANGEMENTS TEST
C              2) MILITARY HANDBOOK TEST
C              3) LAPLACE TEST
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTR'
      ISUBN2='EN  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE TRENDS TEST CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTREN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPTREN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A TRENDS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE IF THE PARAMETER  **
C               **  TEND (TO SPECIFY THE CENSORING TIME)*
C               *****************************************
C
      IHP='TEND'
      IHP2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      TEND=VALUE(ILOCP)
C
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPTREN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH A TRENDS TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               ******************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPTREN2--
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE TRENDS TEST       **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPTREN, AS WE ARE ABOUT TO CALL DPTRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I)
 1216 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPTRE2(Y,NS,XTEMP1,XTEMP2,TEND,MAXNXT,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTREN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTRE2(Y,N,XTEMP1,XTEMP2,TEND,MAXNXT,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A TRENDS ANALYSIS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF FAILURE TIMES
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C     NOTE--3 TRENDS TESTS ARE PERFORMED:
C           1) REVERSE ARRANGEMENT TEST
C           2) MILITARY HANDBOOK TEST
C           3) LAPLACE TEST
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI 77 FORTRAN.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DSUM
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      DIMENSION Y(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTR'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPTRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,IBUGA3
   52 FORMAT('N,IBUGA3 = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I),W(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPTRE2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS NON-POSITIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** NOTE FROM DPTRE2--THE RESPONSE VARIABLE ',
     1'ONLY HAS 1 ELEMENT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  129 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPTRE2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  139 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  REVERSE ARRANGEMENTS TEST             **
C               ********************************************
C
C               ********************************************
C               **  STEP 11A-                             **
C               **  CREATE INTERARRIVAL TIME ARRAY        **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='NO'
      CALL INTARR(Y,N,IWRITE,XTEMP1,NX,IBUGA3,IERROR)
  100 CONTINUE
C
C               ********************************************
C               **  STEP 11B-                             **
C               **  CALCULATE NUMBER OF REVERSALS         **
C               ********************************************
      IREV=0
      DO140J=1,N-1
        DO149K=J+1,N
          IF(XTEMP1(K).GT.XTEMP1(J))IREV=IREV+1
  149   CONTINUE
  140 CONTINUE
      IRMAX=N*(N-1)/2
C
C               *************************
C               **  STEP 11C-          **
C               **  FORM Z STATISTICS  **
C               *************************
C
      ISTEPN='11C'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IRMN90=6
      IRMN95=6
      IRMN99=-1
      IF(N.EQ.4)THEN
        IRMN90=6
        IRMN95=6
        IRMN99=-1
      ELSEIF(N.EQ.5)THEN
        IRMN90=9
        IRMN95=9
        IRMN99=10
      ELSEIF(N.EQ.6)THEN
        IRMN90=12
        IRMN95=13
        IRMN99=14
      ELSEIF(N.EQ.7)THEN
        IRMN90=16
        IRMN95=17
        IRMN99=19
      ELSEIF(N.EQ.8)THEN
        IRMN90=20
        IRMN95=22
        IRMN99=24
      ELSEIF(N.EQ.9)THEN
        IRMN90=25
        IRMN95=27
        IRMN99=30
      ELSEIF(N.EQ.10)THEN
        IRMN90=31
        IRMN95=33
        IRMN99=36
      ELSEIF(N.EQ.11)THEN
        IRMN90=37
        IRMN95=39
        IRMN99=43
      ELSEIF(N.EQ.12)THEN
        IRMN90=43
        IRMN95=46
        IRMN99=50
      ELSEIF(N.GT.12)THEN
        R=REAL(IREV)
        ANUM=R - R*(R-1.0)/4.0 + 0.5
        ADEN=SQRT((2.0*R+5.0)*(R-1.0)*R/72.0)
        Z=ANUM/ADEN
      ENDIF
C
C               ****************************
C               **  STEP 11D-             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='11D'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO199
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,152)
  152 FORMAT('REVERSE ARRANGEMENTS TEST:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,154)N
  154 FORMAT('      NUMBER OF FAILURE TIMES               = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,156)IREV
  156 FORMAT('      OBSERVED NUMBER OF REVERSALS          = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,158)IRMAX
  158 FORMAT('      MAXIMUM POSSIBLE NUMBER OF REVERSALS  = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,160)IRMAX/2
  160 FORMAT('      EXPECTED NUMBER OF REVERSALS          = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.GE.4 .AND. N.LE.12)THEN
      WRITE(ICOUT,162)
  162 FORMAT('      MINIMUM NUMBER OF REVERSALS TO SHOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,164)IRMN90
  164 FORMAT('      EVIDENCE OF IMPROVEMENT (90% LEVEL)   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,166)
  166 FORMAT('      MINIMUM NUMBER OF REVERSALS TO SHOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,168)IRMN95
  168 FORMAT('      EVIDENCE OF IMPROVEMENT (95% LEVEL)   = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,170)
  170 FORMAT('      MINIMUM NUMBER OF REVERSALS TO SHOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,172)IRMN99
  172 FORMAT('      EVIDENCE OF IMPROVEMENT (99% LEVEL)   = ',I8)
      CALL DPWRST('XXX','BUG ')
      ELSEIF(N.GT.12)THEN
      WRITE(ICOUT,182)Z
  182 FORMAT('      VALUE OF TEST STATISTIC               = ',F10.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,184)
  184 FORMAT('      90% CRITICAL VALUE FOR NO IMPROVEMENT = 1.282')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,186)
  186 FORMAT('      95% CRITICAL VALUE FOR NO IMPROVEMEMT = 1.645')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,188)
  188 FORMAT('      99% CRITICAL VALUE FOR NO IMPROVEMENT = 2.33')
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
  199 CONTINUE
C
C               ********************************************
C               **  STEP 21--                             **
C               **  MILITARY HANDBOOK    TEST             **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 21B-                             **
C               **  CALCULATE TEST STATISTIC              **
C               ********************************************
C
       DSUM=0.0D0
       DO210I=1,N
         IF(Y(I).GE.TEND)THEN
           WRITE(ICOUT,212)TEND
  212 FORMAT('***** ERROR FROM DPTRE2--THE SPECIFIED CENSORING ',
     1       'TIME,',E15.7)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,214)
  214 FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         IF(Y(I).LE.0.0)THEN
           WRITE(ICOUT,216)I
  216 FORMAT('***** ERROR FROM DPTRE2--FAILURE ',I8,' IS NOT ',
     1       'POSITIVE.')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,218)Y(I)
  218 FORMAT('      IT HAS THE VALUE ',E15.7)
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         DSUM=DSUM + DLOG(DBLE(TEND/Y(I)))
  210  CONTINUE
       Z=REAL(2.0D0*DSUM)
       INU=2*N
       CALL CHSCDF(Z,INU,CDF)
C
C               ****************************
C               **  STEP 21B-             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='21B'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO299
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,252)
  252 FORMAT('MILITARY HANDBOOK TEST:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,254)N
  254 FORMAT('      NUMBER OF FAILURE TIMES               = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,256)Z
  256 FORMAT('      CHI-SQUARE TEST STATISTIC VALUE       = ',G15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,258)CDF
  258 FORMAT('      CHI-SQUARE TEST STATISTIC CDF VALUE   = ',G15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(0.000.LE.CDF.AND.CDF.LE.0.9)ICONC1='ACCEPT'
      IF(0.000.LE.CDF.AND.CDF.LE.0.95)ICONC2='ACCEPT'
      IF(0.000.LE.CDF.AND.CDF.LE.0.99)ICONC3='ACCEPT'
C
      WRITE(ICOUT,260)
  260 FORMAT(6X,'IMPROVEMENT TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,261)
  261 FORMAT(6X,'HYPOTHESIS     ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,262)ICONC1
  262 FORMAT(6X,'NO TREND          (0.000,0.900)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,263)ICONC2
  263 FORMAT(6X,'NO TREND          (0.000,0.950)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,264)ICONC3
  264 FORMAT(6X,'NO TREND          (0.000,0.990)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  269 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF.GE.0.1)ICONC1='ACCEPT'
      IF(CDF.GE.0.05)ICONC2='ACCEPT'
      IF(CDF.GE.0.01)ICONC3='ACCEPT'
C
      WRITE(ICOUT,270)
  270 FORMAT(6X,'DEGRADATION TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,271)
  271 FORMAT(6X,'HYPOTHESIS     ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,272)ICONC1
  272 FORMAT(6X,'NO TREND          (0.100,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,273)ICONC2
  273 FORMAT(6X,'NO TREND          (0.050,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,274)ICONC3
  274 FORMAT(6X,'NO TREND          (0.010,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  279 CONTINUE
C
  299 CONTINUE
C
C               ********************************************
C               **  STEP 31--                             **
C               **  LAPLACE              TEST             **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 31B-                             **
C               **  CALCULATE TEST STATISTIC              **
C               ********************************************
C
       DSUM=0.0D0
       DO310I=1,N
         IF(Y(I).GE.TEND)THEN
           WRITE(ICOUT,312)TEND
  312 FORMAT('***** ERROR FROM DPTRE2--THE SPECIFIED CENSORING ',
     1       'TIME,',E15.7)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,314)TEND
  314 FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         IF(Y(I).LE.0.0)THEN
           WRITE(ICOUT,316)I
  316 FORMAT('***** ERROR FROM DPTRE2--FAILURE ',I8,' IS NOT ',
     1       'POSITIVE.')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,318)Y(I)
  318 FORMAT('      IT HAS THE VALUE ',E15.7)
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         DSUM=DSUM + DBLE(Y(I)-TEND/2.0)
  310  CONTINUE
       AN=REAL(N)
       Z=REAL(DBLE(SQRT(12.0*AN))*DSUM/DBLE(AN*TEND))
       CALL NORCDF(Z,CDF)
C
C               ****************************
C               **  STEP 31B-             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='31B'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO399
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('LAPLACE TEST:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,354)N
  354 FORMAT('      NUMBER OF FAILURE TIMES               = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,356)Z
  356 FORMAT('      NORMAL TEST STATISTIC VALUE       = ',G15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,358)CDF
  358 FORMAT('      NORMAL TEST STATISTIC CDF VALUE   = ',G15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(0.000.LE.CDF.AND.CDF.LE.0.9)ICONC1='ACCEPT'
      IF(0.000.LE.CDF.AND.CDF.LE.0.95)ICONC2='ACCEPT'
      IF(0.000.LE.CDF.AND.CDF.LE.0.99)ICONC3='ACCEPT'
C
      WRITE(ICOUT,360)
  360 FORMAT(6X,'IMPROVEMENT TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,361)
  361 FORMAT(6X,'HYPOTHESIS     ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,362)ICONC1
  362 FORMAT(6X,'NO TREND          (0.000,0.900)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,363)ICONC2
  363 FORMAT(6X,'NO TREND          (0.000,0.950)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,364)ICONC3
  364 FORMAT(6X,'NO TREND          (0.000,0.990)         ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  369 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF.GE.0.1)ICONC1='ACCEPT'
      IF(CDF.GE.0.05)ICONC2='ACCEPT'
      IF(CDF.GE.0.01)ICONC3='ACCEPT'
C
      WRITE(ICOUT,370)
  370 FORMAT(6X,'DEGRADATION TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,371)
  371 FORMAT(6X,'HYPOTHESIS     ACCEPTANCE INTERVAL    CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,372)ICONC1
  372 FORMAT(6X,'NO TREND          (0.100,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,373)ICONC2
  373 FORMAT(6X,'NO TREND          (0.050,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,374)ICONC3
  374 FORMAT(6X,'NO TREND          (0.010,1)             ',A6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  379 CONTINUE
C
  399 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTRE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTRI2(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 TRIANGLE
C              WITH FRONT FACE VERTICES AT (X1,Y1),
C              (X2,Y2), AND (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-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
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.'TRI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTRI2--')
      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 TRIANGLE           **
C               *********************************
C
      PX(1)=X1
      PY(1)=Y1
C
      PX(2)=X2
      PY(2)=Y2
C
      PX(3)=X3
      PY(3)=Y3
C
      PX(4)=X1
      PY(4)=Y1
C
      NP=4
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.'TRI2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTRI2--')
      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 DPTRIA(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 TRIANGLES
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 VERTICES
C           OF THE TRIANGLE.
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 TRIANGLE WILL GO
C           FROM THE LAST CURSOR POSITION
C           (ASSUMED TO BE AT VERTEX 1)
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 VERTEX 2)
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 VERTEX 3)
C           AND CONTINUING BACK THE START POINT TO CLOSE THE TRIANGLE.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN TRIANGLE WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           (ASSUMED TO BE AT VERTEX 1)
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 VERTEX 2)
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 VERTEX 3)
C           AND THEN CONTINUING BACK THE START POINT TO CLOSE THE TRIANGLE.
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-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRIA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTRIA--')
      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='TRIA'
      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 DPTRIA--')
      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 TRIANGLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH VERTICES (20,20), (50,20), (35,40)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      TRIANGLE 20 20 50 20 35 40')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      TRIANGLE ABSOLUTE 20 20 50 20 35 40')
      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 DPTRI2(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.'TRIA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTRIA--')
      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 DPTRIP(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PRECISION SWITCH
C              AS TRIPLE PRECISION.
C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
C              CALCULATIONS WILL ALL BE CARRIED OUT
C              IN TRIPLE 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-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --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='TRIP'
      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 DPTRIP--')
      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 DPTTES(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A T TEST
C              (1-SAMPLE OR 2-SAMPLE)
CCCCC THE FOLLOWING 3 LINES WERE ADDED     FEBRUARY 1994
C     EXAMPLE--T TEST Y MU
C              T TEST MU Y
C              T TEST Y1 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--JULY      1984.
C     UPDATED         --FEBRUARY  1994.  ADD COMMENTS ABOVE
C     UPDATED         --DECEMBER  1994.  COPY T TEST PARAMETERS
C     UPDATED         --MAY       1995.  BUG FIX (DECLARATIONS)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
CCCCC MAY 1995.  ADD FOLLOWING DECLARATIONS
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED    OCTOBER 1995
      INCLUDE 'DPCOHO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTT'
      ISUBN2='ES  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      NUMVAR=(-999)
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE T TEST CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IF(IARGT(1).EQ.'NUMB')GOTO1110
      IHWUSE='VORP'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO1110
      GOTO1120
 1110 CONTINUE
      VALUE1=ARG(1)
      IUSE1='P'
      GOTO1190
 1120 CONTINUE
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
      GOTO1190
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  IF ARGUMENT 1 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1)  **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A T TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS COULD BE A VARIABLE,        **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IF(IARGT(2).EQ.'NUMB')GOTO2110
      IHWUSE='VORP'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO2110
      GOTO2120
 2110 CONTINUE
      VALUE2=ARG(2)
      IUSE2='P'
      GOTO2190
 2120 CONTINUE
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
      GOTO2190
 2190 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR WHICH A T TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)MINN2
 2215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)IH21,IH22
 2217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)N2
 2218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               ****************************************************************
C               **  STEP 31--                                                 **
C               **  FOR A T TEST,                                             **
C               **  AT LEAST ONE OF THE 2 ARGUMENTS                           **
C               **  MUST BE A VARIABLE.                                       **
C               **  CHECK FOR THIS.                                           **
C               **  IF ONLY 1 ARGUMENT IS A VARIABLE,                         **
C               **  THIS IMPLIES A 1-SAMPLE T TEST.                           **
C               **  (IF SO, COPY THE OTHER ARGUMENT AS THE TARGET MU VALUE).  **
C               **  IF BOTH ARGUMENTS ARE VARIABLES,                          **
C               **  THIS IMPLIES A 2-SAMPLE T TEST.                           **
C               ****************************************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.EQ.'V'.AND.IUSE2.NE.'V')GOTO3110
      IF(IUSE1.NE.'V'.AND.IUSE2.EQ.'V')GOTO3120
      IF(IUSE1.EQ.'V'.AND.IUSE2.EQ.'V')GOTO3130
      GOTO3140
C
 3110 CONTINUE
      NUMVAR=1
      ILOCV=1
      AMU0=VALUE2
      GOTO3190
 3120 CONTINUE
      NUMVAR=1
      ILOCV=2
      AMU0=VALUE1
      GOTO3190
 3130 CONTINUE
      NUMVAR=2
      ILOCV=(-999)
      AMU0=(-999.0)
      GOTO3190
C
 3140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3141)
 3141 FORMAT('***** ERROR IN DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3142)
 3142 FORMAT('      FOR A T TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3143)
 3143 FORMAT('      EITHER THE FIRST ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3144)
 3144 FORMAT('      OR THE SECOND ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3145)
 3145 FORMAT('      (OR BOTH ARGUMENTS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3146)
 3146 FORMAT('      MUST BE A VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3147)
 3147 FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3148)
 3148 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3149)
 3149 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3150)(IANS(I),I=1,IWIDTH)
 3150 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3190 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH A T TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH A T TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  CARRY OUT  THE T TEST      **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPTTES, AS WE ARE ABOUT TO CALL DPTTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
CCCCC THE FOLLOWING CALL WAS CHANGED     DECEMBER 1994
      CALL DPTTE2(Y,NS1,X,NS2,AMU0,NUMVAR,ILOCV,
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STATNU,POOLSD,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
CCCCC THE FOLLOWING SECTION WAS ADDED    DECEMBER 1994
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
CCCCC MAY 1995.  CHANGE FOLLOWING LINE
CCCCC IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPTT'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='NU  '
      VALUE0=STATNU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IF(NUMVAR.GE.2)THEN
         IH='POOL'
         IH2='SD  '
         VALUE0=POOLSD
         CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1   IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1   IANS,IWIDTH,IBUGA3,IERROR)
      ENDIF
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW95'
      VALUE0=CUTL95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW99'
      VALUE0=CUTL99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
 
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTTES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTTE2(Y1,N1,Y2,N2,AMU0,NUMVAR,ILOCV,
CCCCC THE FOLLOWING LINE WAS CHANGED    DECEMBER 1994
CCCCC1XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
     1XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,ICAPTY,
     1STATVA,STATNU,POOLSD,STATCD,CUTL95,CUTU95,CUTL99,CUTU99,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A T TEST
C              (1-SAMPLE OR 2-SAMPLE)
CCCCC THE FOLLOWING 3 LINES WERE ADDED     FEBRUARY 1994
C     EXAMPLE--T TEST Y MU
C              T TEST MU Y
C              T TEST Y1 Y2
C     SAMPLE 1 IS IN INPUT VECTOR Y1
C              (WITH N1 OBSERVATIONS).
C     SAMPLE 2 IS IN INPUT VECTOR Y2
C              (WITH N2 OBSERVATIONS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1984.
C     UPDATED         --APRIL     1987.  (LARRY KNAB CORRECTION--
C                                        BROWNLEE, P. 225)
C     UPDATED         --FEBRUARY  1994.  REFORMAT OUTPUT
C     UPDATED         --FEBRUARY  1994.  DPWRST: 'BUG ' => 'WRIT'
C     UPDATED         --DECEMBER  1994.  COPY T TEST PARAMETERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED   FEBRUARY 1994
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPCO'
      ISUBN2='F2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPTTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,53)AMU0,NUMVAR,ILOCV
   53 FORMAT('AMU0,NUMVAR,ILOCV = ',E15.7,I8,I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1
   55 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N1
      WRITE(ICOUT,57)I,Y1(I)
   57 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N2
   65 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N2
      WRITE(ICOUT,67)I,Y2(I)
   67 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPTTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N1
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPTTE2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y1(1)
      DO1135I=2,N1
      IF(Y1(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPTTE2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NUMVAR.LE.1)GOTO1290
C
      IF(N2.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPTTE2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N2
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N2.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPTTE2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=Y2(1)
      DO1235I=2,N2
      IF(Y2(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPTTE2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               ************************************
C               **   STEP 21--                    **
C               **   BRANCH DEPENDING ON WHETHER  **
C               **   1-SAMPLE T TEST OR           **
C               **   2-SAMPLE T TEST.             **
C               ************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.EQ.1)GOTO3100
      GOTO4100
C
C               ******************************
C               **  STEP 31--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR A 1-SAMPLE T TEST   **
C               ******************************
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      IF(ILOCV.EQ.1)GOTO3110
      GOTO3120
C
 3110 CONTINUE
      N=N1
      CALL MEAN(Y1,N1,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y1,N1,IWRITE,YSD,IBUGA3,IERROR)
      CALL SDMEAN(Y1,N1,IWRITE,YSDM,IBUGA3,IERROR)
      GOTO3180
C
 3120 CONTINUE
      N=N2
      CALL MEAN(Y2,N2,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y2,N2,IWRITE,YSD,IBUGA3,IERROR)
      CALL SDMEAN(Y2,N2,IWRITE,YSDM,IBUGA3,IERROR)
      GOTO3180
C
 3180 CONTINUE
      DEL=YMEAN-AMU0
      T=DEL/YSDM
      DF=N-1
      IDF=DF+0.5
      CALL TCDF(T,IDF,CDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF.LE.0.050)ICONC1='ACCEPT'
      IF(CDF.LE.0.025 .OR. CDF.GE.0.975)ICONC2='ACCEPT'
      IF(CDF.GE.0.950)ICONC3='ACCEPT'
C
CCCCC THE FOLLOWING 7 LINES WERE ADDED     DECEMBER 1994
C
      STATVA=T
      STATCD=CDF
      STATNU=IDF
      CALL TPPF(.025,IDF,CUTL95)
      CALL TPPF(.975,IDF,CUTU95)
      CALL TPPF(.005,IDF,CUTL99)
      CALL TPPF(.995,IDF,CUTU99)
C
C               ******************************
C               **   STEP 32--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR A 1-SAMPLE T TEST  **
C               ******************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>ONE SAMPLE T-TEST FOR THE MEAN</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=250>')
 5047   FORMAT('      </TD>')
 5048   FORMAT('      <TD ALIGN=CENTER VALIGN=TOP WIDTH=50>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5052   FORMAT('         ',I8)
 5055   FORMAT('         ',A8)
 5059   FORMAT('   </TR>')
 5060   FORMAT('         =')
 5057   FORMAT('         &nbsp;')
 5058   FORMAT('         <>')
 5061   FORMAT('         H<sub>0</sub>: Mean ',
     1         '(mu<sub>0</sub>)')
 5062   FORMAT('         H<sub>a</sub>: Mean ',
     1         '(mu<sub>0</sub>)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5058)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('         <B>Sample:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5072   FORMAT('         Number of Observations')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5073   FORMAT('         Mean')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5074   FORMAT('         Standard Deviation')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5075   FORMAT('         Standard Deviation of the Mean')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)YSDM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5081   FORMAT('         <B>Test:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5081)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5082   FORMAT('         Mean - mu<sub>0</sub>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5082)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)DEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5083   FORMAT('         T Test Statistic Value')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5083)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)T
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5084   FORMAT('         Degrees of Freedom')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5084)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)INT(DF+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5085   FORMAT('         T Test Statistic CDF Value')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5085)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)CDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5094   FORMAT('<P>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5094)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=TOP WIDTH=200>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
 5171   FORMAT('         Alternative-<BR>Hypothesis')
 5172   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Acceptance Interval')
 5173   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Conclusion')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM>')
 5247   FORMAT('      </TD>')
 5259   FORMAT('   </TR>')
 5261   FORMAT('         mu<sub>0</sub> <> ',G12.7)
 5262   FORMAT('         (0,0.025), (0.975,1)')
 5263   FORMAT('         ',A6)
 5271   FORMAT('         mu<sub>0</sub> < ',G12.7)
 5272   FORMAT('         (0,0.05)')
 5281   FORMAT('         mu<sub>0</sub> > ',G12.7)
 5282   FORMAT('         (0.95,1)')
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5271)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5272)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5281)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5282)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
 5194   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5194)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf ONE SAMPLE T-TEST FOR THE MEAN}')
 8013 FORMAT(A1,'end{center}')
 8015 FORMAT(5X,'} ',A1,A1)
C
         CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8011)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8020 FORMAT(5X,A1,'begin{tabular} {lcr}')
 8021 FORMAT(5X,'$H_0$ Mean ($',A1,'mu_0$) & = & ',
     1       G15.7,2X,A1,A1)
 8022 FORMAT(5X,'$H_a$ Mean ($',A1,'mu_0$) & $',A1,
     1       'ne$ & ',G15.7,2X,A1,A1)
 8023 FORMAT(5X,' &   & ',2X,A1,A1)
 8024 FORMAT(5X,'{',A1,'bf Sample:} &   & ',2X,A1,A1)
 8025 FORMAT(5X,'Number of Observations & = & ',I8,2X,A1,A1)
 8026 FORMAT(5X,'Mean & = & ',G15.7,2X,A1,A1)
 8027 FORMAT(5X,'Standard Deviation & = & ',
     1       G15.7,2X,A1,A1)
 8037 FORMAT(5X,'Standard Deviation of the Mean & = & ',
     1       G15.7,2X,A1,A1)
 8028 FORMAT(5X,'{',A1,'bf Test:} &   & ',2X,A1,A1)
 8029 FORMAT(5X,'Mean - $',A1,'mu_0$ & = & ', G15.7,2X,A1,A1)
 8030 FORMAT(5X,'T Test Statistic & = & ',G15.7,2X,A1,A1)
 8031 FORMAT(5X,'Degrees of Freedom & = & ',I8,2X,A1,A1)
 8032 FORMAT(5X,'T Test Statistic CDF Value & = & ',G15.7,2X,A1,A1)
 8040 FORMAT(5X,A1,'hline')
 8049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,AMU0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC,AMU0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)YMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)YSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8037)YSDM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,DEL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)T,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)INT(DF + 0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)CDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8091 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8109 FORMAT(A1,'begin{center}')
 8113 FORMAT(A1,'end{center}')
 8115 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8120 FORMAT(5X,A1,'begin{tabular} {ccc}')
 8121 FORMAT(5X,'& {',A1,'bf Alternative} & {',A1,
     1       'bf Alternative}',2X,A1,A1)
 8122 FORMAT(5X,'{',A1,'bf Alternative} & {',A1,
     1       'bf Hypothesis} & {',A1,'bf Hypothesis}',
     1       2X,A1,A1)
 8123 FORMAT(5X,'{',A1,'bf Hypothesis} & {',A1,
     1       'bf Acceptance Interval} & {',A1,
     1       'bf Conclusion}',2X,A1,A1)
 8124 FORMAT(5X,'$',A1,'mu_0 ',A1,'ne$ ',G15.7,
     1       ' & (0,0.025), (0.975,1) & ',
     1       A6,2X,A1,A1)
 8125 FORMAT(5X,'$',A1,'mu_0 <$ ',G15.7,' & (0,0.5) & ',
     1       A6,2X,A1,A1)
 8126 FORMAT(5X,'$',A1,'mu_0 >$ ',G15.7,' & (0.95,1) & ',
     1       A6,2X,A1,A1)
 8140 FORMAT(5X,A1,'hline')
 8149 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8121)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8122)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8123)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8140)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8124)IBASLC,IBASLC,AMU0,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8125)IBASLC,AMU0,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)IBASLC,AMU0,ICONC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8191 FORMAT(A1,'end{center}')
 8193 FORMAT(A1,'end{table}')
 8199 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8199)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE IN RTF (RICH TEXT FORMAT)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3211)
 3211   FORMAT('         ONE SAMPLE T TEST FOR THE MEAN')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3231)AMU0
 3231   FORMAT('NULL HYPOTHESIS: MEAN MU               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3233)AMU0
 3233   FORMAT('ALTERNATIVE HYPOTHESIS: MEAN MU NOT EQUAL ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3220)
 3220   FORMAT('SAMPLE:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3221)N
 3221   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3222)YMEAN
 3222   FORMAT(3X,'MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3223)YSD
 3223   FORMAT(3X,'STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3224)YSDM
 3224   FORMAT(3X,'STANDARD DEVIATION OF MEAN  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3240)
 3240   FORMAT('TEST:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3241)DEL
 3241   FORMAT(3X,'MEAN - MU0                  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3242)T
 3242   FORMAT(3X,'T TEST STATISTIC VALUE      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3243)DF
 3243   FORMAT(3X,'DEGREES OF FREEDOM          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3244)CDF
 3244   FORMAT(3X,'T TEST STATISTIC CDF VALUE  = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3248)
 3248   FORMAT('                 ALTERNATIVE-         ALTERNATIVE-')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3250)
 3250   FORMAT(' ALTERNATIVE-    HYPOTHESIS           HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3251)
 3251   FORMAT(' HYPOTHESIS      ACCEPTANCE INTERVAL  CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3253)AMU0,ICONC2
 3253   FORMAT('MU <> ',G12.7,'(0,0.025) (0.975,1)   ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3252)AMU0,ICONC1
 3252   FORMAT('MU  < ',G12.7,'(0,0.05)              ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3254)AMU0,ICONC3
 3254   FORMAT('MU  > ',G12.7,'(0.95,1)              ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
      GOTO9000
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR A 2-SAMPLE T TEST   **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      CALL MEAN(Y1,N1,IWRITE,Y1MEAN,IBUGA3,IERROR)
      CALL SD(Y1,N1,IWRITE,Y1SD,IBUGA3,IERROR)
      Y1VAR=Y1SD**2
      CALL SDMEAN(Y1,N1,IWRITE,Y1SDM,IBUGA3,IERROR)
C
      CALL MEAN(Y2,N2,IWRITE,Y2MEAN,IBUGA3,IERROR)
      CALL SD(Y2,N2,IWRITE,Y2SD,IBUGA3,IERROR)
      Y2VAR=Y2SD**2
      CALL SDMEAN(Y2,N2,IWRITE,Y2SDM,IBUGA3,IERROR)
C
      AN1=N1
      AN2=N2
C
      DEL=Y1MEAN-Y2MEAN
      POOLSS=(AN1-1.0)*Y1VAR+(AN2-1.0)*Y2VAR
      POOLVA=POOLSS/(AN1+AN2-2.0)
      POOLSD=SQRT(POOLVA)
      POOLN=1.0/((1.0/AN1)+(1.0/AN2))
      DELSD=POOLSD/SQRT(POOLN)
      T=DEL/DELSD
      DF=N1+N2-2
      IDF=DF+0.5
      CALL TCDF(T,IDF,CDF)
C
      DEL2=DEL
      DELVA2=(Y1VAR/AN1)+(Y2VAR/AN2)
      DELSD2=SQRT(DELVA2)
      T2=DEL2/DELSD2
      C=(Y1VAR/AN1)/((Y1VAR/AN1)+(Y2VAR/AN2))
      TERM1=C*C/(AN1-1.0)
      TERM2=(1-C)*(1-C)/(AN2-1.0)
      SUM=TERM1+TERM2
      DF2=1.0/SUM
      IDF2=DF2+0.5
      CALL TCDF(T2,IDF2,CDF2)
C
      TERM11=1.0/(AN1-1.0)
      TERM12=1.0/(AN2-1.0)
      TERM13=1.0/(AN1+AN2-2.0)
CCCCC SUMC=TERM11+TERM12+TERM13
      SUMC=TERM11+TERM12-TERM13
      CBART=1.0+SUMC/3.0
      TERM21=(AN1-1.0)*2*ALOG(Y1SD/POOLSD)
      TERM22=(AN2-1.0)*2*ALOG(Y2SD/POOLSD)
      BBART=(-TERM21-TERM22)
      BART=BBART/CBART
      IDFBAR=1
      CALL CHSCDF(BART,IDFBAR,CDFBAR)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF2.LE.0.050)ICONC1='ACCEPT'
      IF(CDF2.LE.0.025 .OR. CDF2.GE.0.975)ICONC2='ACCEPT'
      IF(CDF2.GE.0.950)ICONC3='ACCEPT'
C
CCCCC THE FOLLOWING 7 LINES WERE ADDED     DECEMBER 1994
C
      STATVA=T
      STATCD=CDF
      STATNU=IDF
      CALL TPPF(.025,IDF,CUTL95)
      CALL TPPF(.975,IDF,CUTU95)
      CALL TPPF(.005,IDF,CUTL99)
      CALL TPPF(.995,IDF,CUTU99)
C
C               ******************************
C               **   STEP 42--              **
C               **   WRITE OUT EVERYTHING   **
C               **   FOR A 2-SAMPLE T TEST  **
C               ******************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5501   FORMAT('</PRE>')
        WRITE(ICOUT,5501)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5561   FORMAT('<UL>')
 5563   FORMAT('<TABLE NOBORDER>')
 5565   FORMAT('   <CAPTION ALIGN=CENTER>')
 5567   FORMAT('      <B>TWO SAMPLE T-TEST FOR EQUAL MEANS</B>')
 5569   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5561)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5563)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5565)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5567)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5569)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5541   FORMAT('   <TR>')
 5543   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=250>')
 5547   FORMAT('      </TD>')
 5548   FORMAT('      <TD ALIGN=CENTER VALIGN=TOP WIDTH=50>')
 5549   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=150>')
 5556   FORMAT('         ',G15.7)
 5554   FORMAT('         ',I8)
 5555   FORMAT('         ',A8)
 5559   FORMAT('   </TR>')
 5560   FORMAT('         =')
 5557   FORMAT('         &nbsp;')
 5558   FORMAT('         <>')
 5761   FORMAT('         H<sub>0</sub>: ',
     1         'mu<sub>1</sub> = mu<sub>2</sub>')
 5762   FORMAT('         H<sub>a</sub>: ',
     1         'mu<sub>1</sub> <> mu<sub>2</sub>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5761)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5762)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5571   FORMAT('         <B>Sample 1:</B>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5571)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5572   FORMAT('         Number of Observations')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5572)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5554)N1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5573   FORMAT('         Mean')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5573)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y1MEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5574   FORMAT('         Standard Deviation')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5574)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y1SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5575   FORMAT('         Standard Deviation of the Mean')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5575)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y1SDM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5576   FORMAT('         <B>Sample 2:</B>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5576)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5572)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5554)N2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5573)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y2MEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5574)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y2SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5575)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y2SDM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5581   FORMAT('         <B>Test (Assume sigma<sub>1</sub> = ',
     1         'sigma<sub>2</sub>):</B>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5581)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5582   FORMAT('         Pooled Standard Deviation')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5582)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)POOLSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5583   FORMAT('         Difference (Delta) in Means')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5583)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)DEL
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5584   FORMAT('         Standard Deviation of Delta')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5583)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)DELSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5585   FORMAT('         T-Test Statistic Value')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5584)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)T
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5586   FORMAT('         Degrees of Freedom')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5586)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5554)INT(DF+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5587   FORMAT('         T-Test Statistic CDF Value')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5587)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)CDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5881   FORMAT('         <B>Test (Do not assume sigma<sub>1</sub> = ',
     1         'sigma<sub>2</sub>):</B>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5881)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5882   FORMAT('         Standard Deviation of Sample 1')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5882)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y1SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5883   FORMAT('         Standard Deviation of Sample 2')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5883)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)Y2SD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5884   FORMAT('         Bartlett CDF Value')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5884)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)CDFBAR
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5885   FORMAT('         Difference (Delta) in Means')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5885)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)DEL2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5886   FORMAT('         Standard Deviation of Delta')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5886)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)DELSD2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5887   FORMAT('         T-Test Statistic Value')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5887)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)T2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5888   FORMAT('         Equivalent Degrees of Freedom')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5888)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5554)INT(DF2+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5889   FORMAT('         T-Test Statistic CDF Value')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5889)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5556)CDF2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5591   FORMAT('</TABLE>')
 5593   FORMAT('</UL>')
 5594   FORMAT('<P>')
        WRITE(ICOUT,5591)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5593)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5594)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5611   FORMAT('<UL>')
 5613   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5611)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5613)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5621   FORMAT('   <TR>')
 5623   FORMAT('      <TH ALIGN=CENTER VALIGN=TOP WIDTH=200>')
 5627   FORMAT('      </TH>')
 5639   FORMAT('   </TR>')
 5661   FORMAT('      <TD COLSPAN=3>')
 5662   FORMAT('          <HR>')
 5671   FORMAT('         Alternative-<BR>Hypothesis')
 5672   FORMAT('         Alternative-Hypothesis<BR>',
     1         'Acceptance Interval')
 5673   FORMAT('         Alternative-Hypothesis<BR>Conclusion')
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5671)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5672)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5673)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5661)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5662)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5741   FORMAT('   <TR>')
 5743   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM>')
 5747   FORMAT('      </TD>')
 5759   FORMAT('   </TR>')
 5861   FORMAT('         mu<sub>1</sub> <> mu<sub>2</sub>')
 5862   FORMAT('         (0.000,0.025) (0.975,1)')
 5863   FORMAT('         ',A6)
 5871   FORMAT('         mu<sub>1</sub> < mu<sub>2</sub>')
 5872   FORMAT('         (0.000,0.05)')
 5981   FORMAT('         mu<sub>1</sub> > mu<sub>2</sub>')
 5982   FORMAT('         (0.95,1)')
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5861)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5862)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5863)ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5871)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5872)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5863)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5981)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5982)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5863)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5691   FORMAT('</TABLE>')
 5693   FORMAT('</UL>')
 5694   FORMAT('<PRE>')
        WRITE(ICOUT,5691)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5693)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5694)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8501 FORMAT(A1,'end{verbatim}')
 8503 FORMAT(A1,'begin{table}')
 8507 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8509 FORMAT(A1,'begin{center}')
 8511 FORMAT(5X,'{',A1,'bf TWO SAMPLE T-TEST FOR EQUAL MEANS}')
 8513 FORMAT(A1,'end{center}')
 8515 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8501)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8503)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8511)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8507)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8513)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8520 FORMAT(5X,A1,'begin{tabular} {lcr}')
 8521 FORMAT(5X,'$H_0$: $',A1,'mu_1$  = $',A1,'mu_2$  & & ',
     1       2X,A1,A1)
 8522 FORMAT(5X,'$H_a$: $',A1,'mu_1$  = $',A1,'mu_2$ & & ',
     1       2X,A1,A1)
 8523 FORMAT(5X,' &   & ',2X,A1,A1)
 8524 FORMAT(5X,'{',A1,'bf Sample 1:} &   & ',2X,A1,A1)
 8624 FORMAT(5X,'{',A1,'bf Sample 2:} &   & ',2X,A1,A1)
 8525 FORMAT(5X,'Number of Observations & = & ',I8,2X,A1,A1)
 8526 FORMAT(5X,'Mean & = & ',G15.7,2X,A1,A1)
 8527 FORMAT(5X,'Standard Deviation & = & ',
     1       G15.7,2X,A1,A1)
 8627 FORMAT(5X,'Standard Deviation of the Mean & = & ',
     1       G15.7,2X,A1,A1)
 8540 FORMAT(5X,A1,'hline')
 8549 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8509)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8520)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8521)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8522)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8524)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8525)N1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8526)Y1MEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8527)Y1SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8627)Y1SDM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8624)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8525)N2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8526)Y2MEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8527)Y2SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8627)Y2SDM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8524)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8525)N2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8526)Y2MEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8527)Y2SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8528 FORMAT(5X,'{',A1,'bf Test: (Assume $',A1,'sigma_1 = ',A1,
     1       'sigma_2$)} &   & ',2X,A1,A1)
 8529 FORMAT(5X,'Pooled Standard Deviation & = & ',
     1       G15.7,2X,A1,A1)
 8530 FORMAT(5X,'Difference (delta) in Means & = & ',
     1       G15.7,2X,A1,A1)
 8531 FORMAT(5X,'Standard Deviation of delta & = & ',
     1       G15.7,2X,A1,A1)
 8532 FORMAT(5X,'T-Test Statistic Value & = & ',G15.7,2X,A1,A1)
 8533 FORMAT(5X,'Degrees of Freedom & = & ',I8,2X,A1,A1)
 8534 FORMAT(5X,'T-Test Statistic CDF Value & = & ',G15.7,2X,A1,A1)
        WRITE(ICOUT,8528)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8529)POOLSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8530)DEL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8531)DELSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8532)T,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8533)INT(DF+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8534)CDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8523)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8628 FORMAT(5X,'{',A1,'bf Test: (Do not assume $',A1,'sigma_1 = ',A1,
     1       'sigma_2$)} &   & ',2X,A1,A1)
 8629 FORMAT(5X,'Standard Deviation of Sample 1 & = & ',
     1       G15.7,2X,A1,A1)
 8630 FORMAT(5X,'Standard Deviation of Sample 2 & = & ',
     1       G15.7,2X,A1,A1)
 8631 FORMAT(5X,'Bartlett CDF Value & = & ',
     1       G15.7,2X,A1,A1)
 8632 FORMAT(5X,'Difference (delta) in Means & = & ',
     1       G15.7,2X,A1,A1)
 8633 FORMAT(5X,'Standard Deviation of delta & = & ',
     1       G15.7,2X,A1,A1)
 8634 FORMAT(5X,'T-Test Statistic Value & = & ',G15.7,2X,A1,A1)
 8635 FORMAT(5X,'Degrees of Freedom & = & ',I8,2X,A1,A1)
 8636 FORMAT(5X,'T-Test Statistic CDF Value & = & ',G15.7,2X,A1,A1)
        WRITE(ICOUT,8628)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8629)Y1SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8630)Y2SD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8631)CDFBAR,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8632)DEL2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8633)DELSD2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8634)T2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8635)INT(DF2+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8636)CDF2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8549)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8591 FORMAT(A1,'end{center}')
        WRITE(ICOUT,8591)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8609 FORMAT(A1,'begin{center}')
 8613 FORMAT(A1,'end{center}')
 8615 FORMAT(5X,'} ',A1,A1)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
 8620 FORMAT(5X,A1,'begin{tabular} {ccc}')
 8621 FORMAT(5X,'{',A1,'bf Alternative-} & {',A1,
     1       'bf Alternative-Hypothesis} & {',
     1       A1,'bf Alternative-Hypothesis}',
     1       2X,A1,A1)
 8622 FORMAT(5X,'{',A1,'bf Hypothesis} & {',A1,
     1       'bf Acceptance Interval} & {',A1,
     1       'bf Conclusion}',2X,A1,A1)
 8724 FORMAT(5X,'$',A1,'mu_1 ',A1,'ne ',A1,'mu_2 $ ',
     1       ' & (0.000,0.025) (0.975,1) & ',A6,2X,A1,A1)
 8625 FORMAT(5X,'$',A1,'mu_1 < ',A1,'mu_2 $ ',
     1       ' & (0.000,0.05) & ',A6,2X,A1,A1)
 8626 FORMAT(5X,'$',A1,'mu_1 > ',A1,'mu_2 $ ',
     1       ' & (0.95,1) & ',A6,2X,A1,A1)
 8640 FORMAT(5X,A1,'hline')
 8649 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8609)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8620)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8621)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8622)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8640)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8724)IBASLC,IBASLC,IBASLC,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8625)IBASLC,IBASLC,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8626)IBASLC,IBASLC,ICONC3,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8649)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
 8691   FORMAT(A1,'end{center}')
 8693   FORMAT(A1,'end{table}')
 8699   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8691)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8693)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8699)IBASLC
        CALL DPWRST('XXX','WRIT')
CCCCC WRITE IN RTF (RICH TEXT FORMAT)
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT('         TWO-SAMPLE T-TEST FOR EQUAL MEANS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4213)
 4213   FORMAT('NULL HYPOTHESIS:        POPULATION MEANS MU1 = MU2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4215)
 4215   FORMAT('ALTERNATIVE HYPOTHESIS: POPULATION MEANS MU1 = MU2')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4220)
 4220   FORMAT('SAMPLE 1:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4221)N1
 4221   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4222)Y1MEAN
 4222   FORMAT(3X,'MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)Y1SD
 4223   FORMAT(3X,'STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4224)Y1SDM
 4224   FORMAT(3X,'STANDARD DEVIATION OF MEAN  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4230)
 4230   FORMAT('SAMPLE 2:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4231)N2
 4231   FORMAT(3X,'NUMBER OF OBSERVATIONS      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4232)Y2MEAN
 4232   FORMAT(3X,'MEAN                        = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4233)Y2SD
 4233   FORMAT(3X,'STANDARD DEVIATION          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4234)Y2SDM
 4234   FORMAT(3X,'STANDARD DEVIATION OF MEAN  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4240)
 4240   FORMAT('IF     ASSUME SIGMA1 = SIGMA2:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4241)POOLSD
 4241   FORMAT(3X,'POOLED STANDARD DEVIATION   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)DEL
 4244   FORMAT(3X,'DIFFERENCE (DELTA) IN MEANS = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)DELSD
 4245   FORMAT(3X,'STANDARD DEVIATION OF DELTA = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)T
 4246   FORMAT(3X,'T-TEST STATISTIC VALUE      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)DF
 4247   FORMAT(3X,'DEGREES OF FREEDOM          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4248)CDF
 4248   FORMAT(3X,'T-TEST STATISTIC CDF VALUE  = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4250)
 4250   FORMAT('IF NOT ASSUME SIGMA1 = SIGMA2:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4251)Y1SD
 4251   FORMAT(3X,'STANDARD DEVIATION SAMPLE 1 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4252)Y2SD
 4252   FORMAT(3X,'STANDARD DEVIATION SAMPLE 2 = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4253)CDFBAR
 4253   FORMAT(3X,'BARTLETT CDF VALUE          = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4254)DEL2
 4254   FORMAT(3X,'DIFFERENCE (DELTA) IN MEANS = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4255)DELSD2
 4255   FORMAT(3X,'STANDARD DEVIATION OF DELTA = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4256)T2
 4256   FORMAT(3X,'T-TEST STATISTIC VALUE      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4257)DF2
 4257   FORMAT(3X,'EQUIVALENT DEG. OF FREEDOM  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4258)CDF2
 4258   FORMAT(3X,'T-TEST STATISTIC CDF VALUE  = ',F11.6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4259)
 4259   FORMAT('                  ALTERNATIVE-         ALTERNATIVE-')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4260)
 4260   FORMAT('ALTERNATIVE-      HYPOTHESIS           HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT('HYPOTHESIS        ACCEPTANCE INTERVAL  CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4263)ICONC2
 4263   FORMAT('MU1 <> MU2         (0,0.025) (0.975,1)   ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)ICONC1
 4262   FORMAT('MU1 < MU2          (0,0.05)              ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4264)ICONC3
 4264   FORMAT('MU1 > MU2          (0.95,1)              ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTTE2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9013)AMU0,NUMVAR,ILOCV
 9013 FORMAT('AMU0,NUMVAR,ILOCV = ',E15.7,I8,I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N1
 9015 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N1
      WRITE(ICOUT,9017)I,Y1(I)
 9017 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N2
 9025 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N2
      WRITE(ICOUT,9027)I,Y2(I)
 9027 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTUMD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A TUKEY MEAN DIFFERENCE PLOT
C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/8
C     ORIGINAL VERSION--SEPTEMBER 1999 .
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
      DIMENSION Y3(MAXOBV)
      DIMENSION Y4(MAXOBV)
      DIMENSION XD(MAXOBV)
      DIMENSION YD(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      DIMENSION YLARGE(MAXOBV)
      DIMENSION YSMALL(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),Y3(1))
      EQUIVALENCE (GARBAG(IGARB4),Y4(1))
      EQUIVALENCE (GARBAG(IGARB5),XD(1))
      EQUIVALENCE (GARBAG(IGARB6),YD(1))
      EQUIVALENCE (GARBAG(IGARB7),YLARGE(1))
      EQUIVALENCE (GARBAG(IGARB8),YSMALL(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTU'
      ISUBN2='MD  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TUMD')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  TREAT THE TUKEY MEAN-DIFFERENCE CASE **
C               *******************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'MEAN'.AND.
     1   IHARG(2).EQ.'DIFF'.AND.IHARG(3).EQ.'PLOT')GOTO1113
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'M   '.AND.
     1   IHARG(2).EQ.'D   '.AND.IHARG(3).EQ.'PLOT')GOTO1113
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'MD  '.AND.
     1   IHARG(2).EQ.'PLOT')GOTO1112
      GOTO9000
C
 1111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='TUMD'
C
C               ****************************************************
C               **  STEP 12--                                     **
C               **  CARRY OUT A GENERAL CHECK FOR THE             **
C               **  PROPER NUMBER OF INPUT ARGUMENTS              **
C               **  (IT SHOULD BE EXACTLY 2).                     **
C               ****************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TUMD')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ****************************************************
C               **  STEP 14--                                     **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE            **
C               **  PROPER NUMBER OF INPUT ARGUMENTS              **
C               **  (IT SHOULD BE EXACTLY 2).                     **
C               ****************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A TUKEY MEAN-DIFFERENCE PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,MIN(IWIDTH,80))
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************
C               **  STEP 15--                                      *
C               **  EXAMINE THE VARIABLES--                        *
C               **  HAS EACH VARIABLE                              *
C               **  ALREADY BEEN DEFINED?                          *
C               **  NOTE THAT     ILISR1, ILISR2,                  *
C               **  IS THE LINE IN THE TABLE                       *
C               **  OF THE FIRST, SECOND VARIABLE                  *
C               **  RESPECTIVELY.                                  *
C               **  NOTE THAT     ICOLR1, ICOLR2,                  *
C               **  IS THE DATA COLUMN (1 TO 10+6)                 *
C               **  OF THE FIRST, SECOND VARIABLE                  *
C               **  RESPECTIVELY.                                  *
C               ****************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,MIN(IWIDTH,80))
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,MIN(IWIDTH,80))
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
      IF(NIRIG2.GT.NIRIG1)NLOCAL=NIRIG2
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH A TUKEY MEAN-DIFFERENCE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE VERTICAL AXIS VARIABLE         **
C               **       THE HORIZONTAL AXIS VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3310I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3310
      J=J+1
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
 3310 CONTINUE
      NS1=J
C
      J=0
      IMAX=NIRIG2
      IF(NQ.LT.NIRIG2)IMAX=NQ
      DO3320I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3320
      J=J+1
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
 3320 CONTINUE
      NS2=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  2 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUN1=0
      IF(NS1.LE.2)ICOUN1=NS1
      IF(NS1.LE.2)GOTO3419
      DO3410I=1,NS1
      IF(Y1(I).LE.-0.0001.OR.Y1(I).GE.0.0001)ICOUN1=ICOUN1+1
 3410 CONTINUE
 3419 CONTINUE
      IF(ICOUN1.LE.MINN2)GOTO3450
C
      ICOUN2=0
      IF(NS2.LE.2)ICOUN2=NS2
      IF(NS2.LE.2)GOTO3429
      DO3420I=1,NS2
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUN2=ICOUN2+1
 3420 CONTINUE
 3429 CONTINUE
      IF(ICOUN2.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A TUKEY MEAN-DIFFERENCE PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)ICOUN1,ICOUN2
 3459 FORMAT('(ICOUN1, ICOUN2 = ',2I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,MIN(IWIDTH,80))
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ****************************************************
C               **  STEP 41--                                      *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR    *
C               **   THE PLOT.                                     *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .    *
C               **  THIS WILL BE BOTH ONES FOR BOTH CASES          *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  *
C               ****************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'TUMD')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS=NS1
      IF(NS2.GT.NS1)NS=NS2
      CALL DPTUM2(Y1,NS1,Y2,NS2,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1YLARGE,YSMALL,
     1IBUGG3,ISUBRO,IERROR)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'TUMD')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTUMD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUN1,ICOUN2
 9031 FORMAT('ICOUN1,ICOUN2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)NS1,NS2,NS
 9053 FORMAT('NS1,NS2,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTUM2(Y,NY,X,NX,ICASPL,MAXN,
     1Y2,X2,D2,N2,NPLOTV,
     1YLARGE,YSMALL,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A TUKEY MEAN-DIFFERENCE PLOT
C              (USEFUL FOR DISTRIBUTIONALLY COMPARING 2 DATA SETS).
C              AFTER CALCULATING COORDINATES FOR Q-Q PLOT, CALCULATE
C              (Bi - Ti) VERSUS (Bi+Ti)/2 WHERE Bi AND Ti ARE
C              THE QUANTILES FOR THE RESPECTIVE DATA SETS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/9
C     ORIGINAL VERSION--SEPTEMBER 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASE
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION YLARGE(*)
      DIMENSION YSMALL(*)
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='DPQU'
      ISUBN2='A2  '
C
      IERROR='NO'
C
      ICASE=ICASPL
C
      ANY=NY
      ANX=NX
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'TUM2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,NX,NPLOTV
   53 FORMAT('ICASPL,MAXN,NX,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NY
   60 FORMAT(' NY = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NY.LE.0)GOTO63
      DO61I=1,NY
      WRITE(ICOUT,62)I,Y(I)
   62 FORMAT('I,Y(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   63 CONTINUE
      WRITE(ICOUT,70)NX
   70 FORMAT(' NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NX.LE.0)GOTO73
      DO71I=1,NX
      WRITE(ICOUT,72)I,X(I)
   72 FORMAT('I,X(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   71 CONTINUE
   73 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NY.GE.1.AND.NX.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)NY,NX
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',2I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(NY.GE.2.AND.NX.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,NY
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
      HOLD=X(1)
      DO1140I=1,NY
      IF(X(I).NE.HOLD)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)HOLD
 1143 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1149 CONTINUE
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  SORT Y AND SORT X                             **
C               ****************************************************
C
      CALL SORT(X,NX,X)
      CALL SORT(Y,NY,Y)
C
C               *****************************************
C               **  STEP 22--                          **
C               **  DETERMINE THE TYPE CASE            **
C               **  EQUAL SAMPLE SIZES OR NOT)         **
C               **  AND BRANCH ACORDINGLY              **
C               *****************************************
C
      ICASE='UNEQ'
      IF(NY.EQ.NX)ICASE='EQUA'
      IF(ICASE.EQ.'EQUA')GOTO5100
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  DETERMINE THE SMALLER OF THE 2--            **
C               **  NY OR NX                                    **
C               **  DETERMINE THE LARGER OF THE 2--             **
C               **  NY OR NX                                    **
C               **************************************************
C
      NSMALL=NX
      IF(NY.LT.NX)NSMALL=NY
      ANSMAL=NSMALL
C
      NLARGE=NX
      IF(NY.GT.NX)NLARGE=NY
      ANLARG=NLARGE
C
C               ****************************************************
C               **  STEP 24--                                     **
C               **  STEP THROUGH THE VARIOUS SORTED VALUES OF     **
C               **  THE SMALLER OF Y OR X.                        **
C               **  COMPUTE A CORRESPONDING PERCENTAGE.           **
C               **  ESTIMATE THIS PERCENT  POINT                  **
C               **  IN THE LARGER OF Y OR X.                      **
C               ****************************************************
C
      DO2400I=1,NSMALL
      AI=I
      PSMALL=(AI-0.5)/ANSMAL
      IF(NY.LE.NX)YSMALL(I)=Y(I)
      IF(NY.GT.NX)YSMALL(I)=X(I)
C
      PLARGE=0.0
      DO2410J=1,NLARGE
      AJ=J
      J2=J
      J2M1=J2-1
      PPRIOR=PLARGE
      PLARGE=(AJ-0.5)/ANLARG
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TUM2')
     1WRITE(ICOUT,777)I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR
  777 FORMAT('I,J,J2,J2M1,PSMALL,PLARGE,PPRIOR = ',4I8,3E15.7)
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'TUM2')
     1CALL DPWRST('XXX','BUG ')
      IF(PLARGE.LT.PSMALL)GOTO2410
      IF(PLARGE.EQ.PSMALL)GOTO2411
      GOTO2412
C
 2411 CONTINUE
      IF(NY.LE.NX)YLARGE(I)=X(J2)
      IF(NY.GT.NX)YLARGE(I)=Y(J2)
      GOTO2400
C
 2412 CONTINUE
      RATIO=(PSMALL-PPRIOR)/(PLARGE-PPRIOR)
      IF(NY.LE.NX)YLARGE(I)=RATIO*X(J2M1)+(1.0-RATIO)*X(J2)
      IF(NY.GT.NX)YLARGE(I)=RATIO*Y(J2M1)+(1.0-RATIO)*Y(J2)
      GOTO2400
C
 2410 CONTINUE
C
 2400 CONTINUE
C
C               *******************************************
C               **  STEP 51--                            **
C               **  FORM PLOT COORDINATES                **
C               *******************************************
C
 5100 CONTINUE
      IF(ICASE.EQ.'EQUA')GOTO5110
      GOTO5120
C
 5110 CONTINUE
      J=0
      DO5111I=1,NY
      J=J+1
      ADIFF=Y(I)-X(I)
      AMEAN=(Y(I)+X(I))/2.0
      Y2(J)=ADIFF
      X2(J)=AMEAN
      D2(J)=1.0
 5111 CONTINUE
      J=J+1
      X2(J)=X2(1)
      Y2(J)=0.0
      D2(J)=2.0
      J=J+1
      X2(J)=X2(NY)
      Y2(J)=0.0
      D2(J)=2.0
      GOTO9000
C
 5120 CONTINUE
      J=0
      DO5121I=1,NSMALL
      J=J+1
      IF(NY.LE.NX)Y2(J)=YSMALL(I)
      IF(NY.GT.NX)Y2(J)=YLARGE(I)
      IF(NY.LE.NX)X2(J)=YLARGE(I)
      IF(NY.GT.NX)X2(J)=YSMALL(I)
      D2(J)=1.0
      ADIFF=Y2(J)-X2(J)
      AMEAN=(Y2(J)+X2(J))/2.0
      Y2(J)=ADIFF
      X2(J)=AMEAN
 5121 CONTINUE
C
      J=J+1
      X2(J)=X2(1)
      Y2(J)=0.0
      D2(J)=2.0
      J=J+1
      X2(J)=X2(NSMALL)
      Y2(J)=0.0
      D2(J)=2.0
C
      N2=J
      NPLOTV=3
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTUM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASE
 9013 FORMAT('ICASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9031)NLARGE
 9031 FORMAT('NLARGE = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9032I=1,NLARGE
      WRITE(ICOUT,9033)I,YLARGE(I)
 9033 FORMAT('I,YLARGE(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
      WRITE(ICOUT,9041)NSMALL
 9041 FORMAT('NSMALL = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9042I=1,NSMALL
      WRITE(ICOUT,9043)I,YSMALL(I)
 9043 FORMAT('I,YSMALL(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
      WRITE(ICOUT,9051)NY,NX,NSMALL,NLARGE
 9051 FORMAT('NY,NX,NSMALL,NLARGE = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)RATIO
 9052 FORMAT('RATIO = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPTY3B(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,
     1                  IBUGA3,
     1                  IFOUZ2,ISTAR2,ISTOP2,
     1                  ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPTYP3
C           AND HAS BEEN DUPLICATED ONLY FOR MAPPING PURPOSES.
C           DATE--SEPTEMBER 5, 1981.
C
C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.) BETWEEN
C              COLUMNS ISTAR1 AND ISTOP1
C              FOR THE STRING DEFINED IN STRIN AND ISTRI2.
C     NOTE THAT THE STRING DEFINED IN ISTRIN AND ISTRI2
C     MAY BE EXPRESSED IN SEVERAL WAYS--
C          1) EXPLICITELY, E.G., LET    FOR    SUBSET, ETC.
C          2) IMPLICITELY WITH ! REPRESENTING THE FIRST
C             NON-BLANK CHARACTER THAT IS ENCOUNTERED;
C          3) IMPLICITELY WITH ; REPRESENTING ANY STRING
C             (INCLUDING ALL CHARACTERS, EVEN BLANKS));
C          4) IMPLICITELY WITH : REPRESENTING THE FIRST
C            BLANK CHARACTER THAT IS ENCOUNTERED.
C     NOTE--A GIVEN ARGUMENT MAY END UP WITH
C            3 DIFFERENT REPRESENTATIONS--
C            HOLLERITH, INTEGER, AND FLOATING POINT.
C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
C                                VARIABLE CONTAINING THE INPUT LINE
C                                TO BE EXAMINED.
C                     --IWIDTH = THE (FULL) WIDTH OF THE INPUT LINE
C                                (THAT IS, THE NUMBER OF COLUMNS)
C                     --ISTAR1 = THE FIRST COLUMN FOR WHICH THE
C                                SCAN IS TO BE CARRIED OUT.
C                     --ISTOP1 = THE LAST  COLUMN FOR WHICH THE
C                                SCAN IS TO BE CARRIED OUT.
C                     --ISTRIN = THE HOLLERITH VARIABLE
C                                WHICH CONTAINS CHARACTERS 1 TO 4
C                                OF THE STRING TO BE SEARCHED FOR.
C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
C                                TO 4 CHARACTERS) OR IMPLICITELY
C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
C                                IS MORE GENERAL IN
C                                OTHER WAYS ALSO.
C                     --ISTRI2 = THE HOLLERITH VARIABLE
C                                WHICH CONTAINS CHARACTERS 5 TO 8
C                                OF THE STRING TO BE SEARCHED FOR.
C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
C                                TO 4 CHARACTERS) OR IMPLICITELY
C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
C                                IS MORE GENERAL IN
C                                OTHER WAYS ALSO.
C                     --INEX   = A HOLLERITH VARIABLE WHICH
C                                WILL CONTAIN ONE OF THE FOLLOWING 4 VALUES--
C                                II, IE, EI, EE THAT STANDS FOR
C                                WHERE I STANDS FOR INCLUSIVE AND
C                                WHERE E STANDS FOR EXCLUSIVE;
C                                INEX SPECIFIES WHETHER THE FIRST OR LAST CHARAC
C                                CHARACTER IS TO BE INCLUDED OR EXCLUDED IN
C                                IN DEFINING ISTAR2 AND ISTOP2.
C     OUTPUT ARGUMENTS--IFOUZ2 = A HOLLERITH VARIABLE
C                                WITH THE VALUE 'YES'
C                                IF THE STRING WAS FOUND;
C                                AND THE VALUE 'NO'
C                                IF THE STRING WAS NOT FOUND.
C                     --ISTAR2 = THE START COLUMN OF THE FOUND STRING
C                     --ISTOP2 = THE STOP COLUMN OF THE FIUND STRING.
C                     --ITYPE2 = A HOLLERITH VARIABLE
C                                WITH THE VALUE 'WORD' IF THE STRING CONTAINS
C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
C                                AND WITH THE VALUE 'NUMB' IF THE STRING CONTA
C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
C                                (WITH INTERMITTENT BLANKS IGNORED).
C                     --IHOL   = THE HOLLERITH VARIABLE
C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
C                                OF CHARACTERS 1 TO 4 OF THE FOUND STRING.
C                     --IHOL2  = THE HOLLERITH VARIABLE
C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
C                                OF CHARACTERS 5 TO 8 OF THE FOUND STRING.
C                     --INT    = THE INTEGER VARIABLE
C                                CONTAINING THE INTEGER REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND STRING.
C                     --FLOAT  = THE FLOATING POINT VARIABLE
C                                CONTAINING THE FLOATING POINT REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND STRING.
C                     --IERROR = A HOLLERITH VARIABLE WITH VALUE
C                                'YES' OR 'NO' INDICATING IF AN
C                                ERROR CONDITION EXISTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 ISTRIN
      CHARACTER*4 ISTRI2
      CHARACTER*4 INEX
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUZ2
      CHARACTER*4 ITYPE2
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERROR
C
      CHARACTER*4 IBUG1
      CHARACTER*4 IBUG2
      CHARACTER*4 ITEMP
      CHARACTER*4 IFLUNK
      CHARACTER*4 ISTRI3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
C
      DIMENSION ISTRI3(20)
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='DPTY'
      ISUBN2='P3  '
C
      IERROR='NO'
C
      I2=0
      IPJM1=0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTY3B--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISTAR1,ISTOP1
   53 FORMAT('ISTAR1,ISTOP1 = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISTRIN,ISTRI2
   54 FORMAT('ISTRIN,ISTRI2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      NUMASC=4
C
      IBUG1='OFF'
      IBUG2='OFF'
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUG1.EQ.'OFF')GOTO150
      WRITE(ICOUT,101)
  101 FORMAT('AT THE BEGINNING OF DPTY3B--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)IWIDTH
  102 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)(IANS(I),I=1,IWIDTH)
  103 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX
  104 FORMAT('ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX = ',I8,I8,A4,A4,A4)
      CALL DPWRST('XXX','BUG ')
  150 CONTINUE
      IFOUZ2='NO'
      ISTAR2=-1
      ISTOP2=-1
      ITYPE2='9999'
      IHOL ='9999'
      IHOL2='9999'
      INT = -999999
      FLOAT=-999999.0
C
C               ************************************************************
C               **  STEP 2--                                              **
C               **  DECOMPOSE THE INPUT SEARCH STRING INTO A1 CHARACTERS  **
C               ************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IMAX=2*NUMASC
      DO300I=1,IMAX
      I2=I
      J=I
      IF(I.GT.NUMASC)J=I-NUMASC
      ISTAR3=NUMBPC*(J-1)
      ISTAR3=IABS(ISTAR3)
      ITEMP='    '
      IF(I.LE.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRIN,0,NUMBPC,ITEMP)
      IF(I.GT.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRI2,0,NUMBPC,ITEMP)
      IF(ITEMP.EQ.'    ')GOTO350
      ISTRI3(I)=ITEMP
  300 CONTINUE
      ILEN2=I2
      GOTO390
  350 CONTINUE
      ILEN2=I2-1
  390 CONTINUE
C
      IF(IBUG2.EQ.'OFF')GOTO399
      WRITE(ICOUT,391)
  391 FORMAT('IN THE MIDDLE OF DPTY3B (AFTER STEP 2)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,392)ILEN2
  392 FORMAT('ILEN2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,393)(ISTRI3(I),I=1,ILEN2)
  393 FORMAT('ISTRI3(.) = ',6A1)
      CALL DPWRST('XXX','BUG ')
  399 CONTINUE
C
C               ****************************************************************
C               **  STEP 3--
C               **  DISTINGUISH BETWEEN THE 3 TYPES OF POSSIBLE SEARCH STRINGS--
C               **  1) AN EXPLICITELY-DEFINED STRING; E.G.,
C               **     LET     FOR     SUBSET     =     5.3     -2.6666666
C               **     (AS IN COMMANDS, KEY WORDS, AND NUMBERS);
C               **  2) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
C               **     AND ENDING WITH SOME SPECIFIED CHARACTER; E.G., XXXXX(
C               **     (AS IN THE VARIABLE NAME OF A SUBSCRIPTED VARIABLE,
C               **     OR THE ARGUMENT (I. E., THE SUBSCRIPT) IN A SUBSCRIPTED
C               **     VARIABLE);
C               **  3) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
C               **     AND ENDING WITH THE FIRST SUBSEQUENT BLANK CHARCTER (EXCL
C               **     E.G., XXXX
C               **     (AS IN SOME UNSPECIFIED PARAMETER OR VARIABLE NAME).
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ICASE=1
      IF(ISTRI3(1).NE.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
     1ICASE=2
      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
     1ICASE=3
      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).EQ.':')
     1ICASE=4
      IF(ILEN2.EQ.1.OR.ILEN2.EQ.2)ICASE=1
C
      IF(IBUG2.EQ.'OFF')GOTO398
      WRITE(ICOUT,395)
  395 FORMAT('AFTER STEP 3 OF DPTY3B--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,396)ICASE
  396 FORMAT('ICASE = ',I8)
      CALL DPWRST('XXX','BUG ')
  398 CONTINUE
C
C               *********************************************************
C               **  STEP 4--                                           **
C               **  DETERMINE IF THE DESIRED SEARCH STRING IS PRESENT  **
C               *********************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(ICASE.EQ.1)GOTO400
      IF(ICASE.EQ.2)GOTO500
      IF(ICASE.EQ.3)GOTO600
      IF(ICASE.EQ.4)GOTO700
C
  400 CONTINUE
      DO410I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(1))GOTO420
      GOTO410
  420 CONTINUE
      DO430J=1,ILEN2
      IPJM1=J+I-1
      IF(IPJM1.GT.ISTOP1)GOTO410
      IF(IANS(IPJM1).EQ.ISTRI3(J))GOTO430
      GOTO410
  430 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=I2
      IF(INEX.EQ.'IE')ISTAR2=I2
      IF(INEX.EQ.'EI')ISTAR2=I2+1
      IF(INEX.EQ.'EE')ISTAR2=I2+1
      IF(INEX.EQ.'II')ISTOP2=IPJM1
      IF(INEX.EQ.'IE')ISTOP2=IPJM1-1
      IF(INEX.EQ.'EI')ISTOP2=IPJM1
      IF(INEX.EQ.'EE')ISTOP2=IPJM1-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
  410 CONTINUE
      IFOUZ2='NO'
      GOTO9000
C
  500 CONTINUE
      DO510I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(1))GOTO520
  510 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  520 CONTINUE
      IMIN=I2
      DO530I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO540
  530 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  540 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II')ISTOP2=I2
      IF(INEX.EQ.'IE')ISTOP2=I2-1
      IF(INEX.EQ.'EI')ISTOP2=I2
      IF(INEX.EQ.'EE')ISTOP2=I2-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  600 CONTINUE
      DO610I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).NE.' ')GOTO620
  610 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  620 CONTINUE
      IMIN=I2
      DO630I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO640
  630 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  640 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II')ISTOP2=I2
      IF(INEX.EQ.'IE')ISTOP2=I2-1
      IF(INEX.EQ.'EI')ISTOP2=I2
      IF(INEX.EQ.'EE')ISTOP2=I2-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  700 CONTINUE
      DO710I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).NE.' ')GOTO720
  710 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  720 CONTINUE
      IMIN=I2
      DO730I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.' ')GOTO740
  730 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  740 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II')ISTOP2=I2
      IF(INEX.EQ.'IE')ISTOP2=I2-1
      IF(INEX.EQ.'EI')ISTOP2=I2
      IF(INEX.EQ.'EE')ISTOP2=I2-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  900 CONTINUE
C
C     NOTE--THE FOLLOWING SECTION HAS BEEN 'BUGGED' OUT
C           TO CIRCUMVENT A PROBLEM WITH Y=(...
C           WHILE IT STILL LOOKED FOR A VARIABLE NAME
C           BETWEEN THE = AND THE (     .
C     CAUTION--WHEN IBUGA3 = 'OFF', AS IT USUALLY IS,
C              IERROR CAN NEVER BE 'YES'
C              UPON RETURN FROM DPTY3B:
C              BUT WHEN IBUGA3 = 'ON' (AS IN ERROR TRACING)
C              IERROR MAY = 'YES' WHICH MAY CHANGE THE
C              LOGIC PATH BACK IN DPTYP2.
C
      IF(IBUGA3.EQ.'OFF')GOTO9000
      WRITE(ICOUT,921)
  921 FORMAT('***** INTERNAL ERROR IN DPTY3B SUBROUTINE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,922)
  922 FORMAT('ISTAR2 GREATER THAN ISTOP2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,923)ISTAR2,ISTOP2
  923 FORMAT('ISTAR2, ISTOP2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,924)ICASE
  924 FORMAT('ICASE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,925)IWIDTH
  925 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,926)(IANS(I),I=1,IWIDTH)
  926 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,927)ISTAR1,ISTOP1
  927 FORMAT('ISTAR1, ISTOP1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,928)ILEN2
  928 FORMAT('ILEN2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,929)(ISTRI3(I),I=1,ILEN2)
  929 FORMAT('ISTRI3(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,930)ISTRIN,ISTRI2
  930 FORMAT('ISTRIN,ISTRI2 = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,931)INEX
  931 FORMAT('INEX = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  990 CONTINUE
C
C               ********************************************************
C               **  STEP 5--                                          **
C               **  CONVERT THE STRING INTO 2 HOLLERITH A4 WORDS.     **
C               **  IF MORE THAN 8 CHARACTERS, CONVERT ONLY           **
C               **  THE FIRST 8 CHARACTERS.                           **
C               **  OUTPUT THESE HOLLERITH WORDS AS IHOL AND IHOL2.   **
C               ********************************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IHOL ='    '
      IHOL2='    '
      IMAX=2*NUMASC
      J=0
      DO1000I=ISTAR2,ISTOP2
      J=J+1
      K=J
      IF(J.GT.NUMASC)K=J-NUMASC
      ISTAR3=NUMBPC*(K-1)
      ISTAR3=IABS(ISTAR3)
      IF(J.LE.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL)
      IF(J.GT.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL2)
      IF(J.GE.IMAX)GOTO1050
 1000 CONTINUE
 1050 CONTINUE
C
C               ****************************************************************
C               **  STEP 6--
C               **  CONVERT (IF POSSIBLE) THE STRING INTO AN INTEGER ARGUMENT.
C               **  OUTPUT  THIS INTEGER VALUE IN INT.
C               ****************************************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IFLUNK='NO'
      ITYPE2='NUMB'
      IDIG=0
      ISIGN=0
      IDECPT=0
      ISUM=0
      DO2700I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO2700
      IF(IANS(IREV).EQ.'0')GOTO2710
      IF(IANS(IREV).EQ.'1')GOTO2711
      IF(IANS(IREV).EQ.'2')GOTO2712
      IF(IANS(IREV).EQ.'3')GOTO2713
      IF(IANS(IREV).EQ.'4')GOTO2714
      IF(IANS(IREV).EQ.'5')GOTO2715
      IF(IANS(IREV).EQ.'6')GOTO2716
      IF(IANS(IREV).EQ.'7')GOTO2717
      IF(IANS(IREV).EQ.'8')GOTO2718
      IF(IANS(IREV).EQ.'9')GOTO2719
      IF(IANS(IREV).EQ.'+')GOTO2720
      IF(IANS(IREV).EQ.'-')GOTO2721
      IF(IANS(IREV).EQ.'.')GOTO2722
      IFLUNK='YES'
      GOTO2800
 2710 ITERM=0
      GOTO2725
 2711 ITERM=1
      GOTO2725
 2712 ITERM=2
      GOTO2725
 2713 ITERM=3
      GOTO2725
 2714 ITERM=4
      GOTO2725
 2715 ITERM=5
      GOTO2725
 2716 ITERM=6
      GOTO2725
 2717 ITERM=7
      GOTO2725
 2718 ITERM=8
      GOTO2725
 2719 ITERM=9
      GOTO2725
 2720 ISIGN=ISIGN+1
      GOTO2700
 2721 ISIGN=ISIGN+1
      ISUM=-ISUM
      GOTO2700
 2722 IDECPT=IDECPT+1
      IF(IDECPT.EQ.1.AND.IDIG.EQ.0)GOTO2700
      GOTO2800
 2725 IDIG=IDIG+1
      TERM2=10.0**(IDIG-1)
      ITERM2=TERM2 + 0.01
      ISUM=ISUM+ITERM*ITERM2
 2700 CONTINUE
      IF(IDIG.LE.0)GOTO2800
      IF(ISIGN.GE.2)GOTO2800
      INT=ISUM
 2800 CONTINUE
      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
 2100 CONTINUE
 2999 CONTINUE
C
C               ********************************************************
C               **  STEP 7--                                          **
C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING  **
C               **  POINT ARGUMENT.                                   **
C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.        **
C               ********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      AMIN=-1000000.
      AMAX=+1000000.
      IFLUNK='NO'
      ITYPE2='NUMB'
      FLOAT=-1.0
C
      ILOC=0
      IDECPT=0
      DO3060I=ISTAR2,ISTOP2
      IF(IANS(I).EQ.'.')ILOC=I
      IF(IANS(I).EQ.'.')IDECPT=IDECPT+1
 3060 CONTINUE
      IF(IDECPT.GE.2)GOTO3900
      IF(IDECPT.EQ.1)GOTO3150
      DO3100I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO3100
      IF(IANS(IREV).EQ.'0')GOTO3110
      IF(IANS(IREV).EQ.'1')GOTO3110
      IF(IANS(IREV).EQ.'2')GOTO3110
      IF(IANS(IREV).EQ.'3')GOTO3110
      IF(IANS(IREV).EQ.'4')GOTO3110
      IF(IANS(IREV).EQ.'5')GOTO3110
      IF(IANS(IREV).EQ.'6')GOTO3110
      IF(IANS(IREV).EQ.'7')GOTO3110
      IF(IANS(IREV).EQ.'8')GOTO3110
      IF(IANS(IREV).EQ.'9')GOTO3110
      IFLUNK='YES'
      IF(IANS(IREV).EQ.'+')GOTO3900
      IF(IANS(IREV).EQ.'-')GOTO3900
      GOTO3900
 3100 CONTINUE
      IFLUNK='YES'
      GOTO3900
 3110 ILOC=IREV+1
 3150 CONTINUE
      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
C
      SIGN=1.0
      IDIGI=0
      ISIGN=0
      SUMI=0
      ILOCM1=ILOC-1
      IF(ILOCM1.LT.ISTAR2)GOTO3250
      DO3200I=ISTAR2,ILOCM1
      IREV=ILOCM1-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO3200
      IF(IANS(IREV).EQ.'0')GOTO3210
      IF(IANS(IREV).EQ.'1')GOTO3211
      IF(IANS(IREV).EQ.'2')GOTO3232
      IF(IANS(IREV).EQ.'3')GOTO3213
      IF(IANS(IREV).EQ.'4')GOTO3214
      IF(IANS(IREV).EQ.'5')GOTO3215
      IF(IANS(IREV).EQ.'6')GOTO3216
      IF(IANS(IREV).EQ.'7')GOTO3217
      IF(IANS(IREV).EQ.'8')GOTO3218
      IF(IANS(IREV).EQ.'9')GOTO3219
      IF(IANS(IREV).EQ.'+')GOTO3220
      IF(IANS(IREV).EQ.'-')GOTO3221
      IFLUNK='YES'
      GOTO3900
 3210 ITERM=0
      GOTO3225
 3211 ITERM=1
      GOTO3225
 3232 ITERM=2
      GOTO3225
 3213 ITERM=3
      GOTO3225
 3214 ITERM=4
      GOTO3225
 3215 ITERM=5
      GOTO3225
 3216 ITERM=6
      GOTO3225
 3217 ITERM=7
      GOTO3225
 3218 ITERM=8
      GOTO3225
 3219 ITERM=9
      GOTO3225
 3220 ISIGN=ISIGN+1
      GOTO3200
 3221 ISIGN=ISIGN+1
      SIGN=-SIGN
      GOTO3200
 3225 IDIGI=IDIGI+1
      TERM=ITERM
      IEXP=IDIGI-1
      SUMI=SUMI+TERM*(10.0**IEXP)
 3200 CONTINUE
 3250 CONTINUE
      IF(ISIGN.GE.2)GOTO3900
      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
C
      IDIGD=0
      SUMD=0.0
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.ISTOP2)GOTO3350
      DO3300I=ILOCP1,ISTOP2
      IF(IANS(I).EQ.' ')GOTO3300
      IF(IANS(I).EQ.'0')GOTO3310
      IF(IANS(I).EQ.'1')GOTO3311
      IF(IANS(I).EQ.'2')GOTO3312
      IF(IANS(I).EQ.'3')GOTO3333
      IF(IANS(I).EQ.'4')GOTO3314
      IF(IANS(I).EQ.'5')GOTO3315
      IF(IANS(I).EQ.'6')GOTO3316
      IF(IANS(I).EQ.'7')GOTO3317
      IF(IANS(I).EQ.'8')GOTO3318
      IF(IANS(I).EQ.'9')GOTO3319
      IFLUNK='YES'
      GOTO3900
 3310 ITERM=0
      GOTO3325
 3311 ITERM=1
      GOTO3325
 3312 ITERM=2
      GOTO3325
 3333 ITERM=3
      GOTO3325
 3314 ITERM=4
      GOTO3325
 3315 ITERM=5
      GOTO3325
 3316 ITERM=6
      GOTO3325
 3317 ITERM=7
      GOTO3325
 3318 ITERM=8
      GOTO3325
 3319 ITERM=9
      GOTO3325
 3325 IDIGD=IDIGD+1
      TERM=ITERM
      SUMD=SUMD+TERM/(10.0**IDIGD)
 3300 CONTINUE
 3350 CONTINUE
      IF(IBUG2.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
      IF(IBUG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IDIGT=IDIGI+IDIGD
      IF(IDIGT.LE.0)GOTO3900
      FLOAT=SUMI+SUMD
      IF(SIGN.LT.0.0)FLOAT=-FLOAT
      IF(AMIN.LE.FLOAT.AND.FLOAT.LE.AMAX)GOTO3000
      GOTO3900
C
 3900 CONTINUE
      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
 3000 CONTINUE
 3999 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9900
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9001)
 9001 FORMAT('AT THE END OF DPTY3B--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9002)IFOUZ2,ISTAR2,ISTOP2
 9002 FORMAT('IFOUZ2, ISTAR2, ISTOP2 = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9003)ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR
 9003 FORMAT('ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR = ',A4,2X,A4,A4,2X,
     1I8,F15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
 9900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTYP2(IANS,IWIDTH,IHNAME,IHNAM2,NUMNAM,MAXNAM,IBUGA3,
     1           IUSE,IVALUE,VALUE,IN,
     1           IFOUNZ,IBEGIN,IEND,
     1           ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1           NUMCL,NUMPL,NUMAOL,ITYW1L,ICAT1L,INLI1L,ITYW2L,
     1           NUMCR,NUMPR,NUMAOR,ITYW1R,ICAT1R,INLI1R,ITYW2R)
C
C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.)
C              AND EXTRACT INFORMATION
C              REGARDING THE EXISTENCE AND LOACTION
C              OF CERTAIN SUBSTRINGS USED IN THE LET COMMAND.
C     THIS SUBROUTINE (DPTYP2) IS CALLED BY DPLET.
C     OTHER SUBROUINTES NEEDED--DPTYP3
C     MOST GENERAL FORM--LET X(I) = XXX FOR I = A B C
C                      --LET X(I) = XXX SUBSET XX A B
C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
C                                VARIABLE CONTAINING THE INPUT LINE
C                                TO BE EXAMINED.
C                     --IWIDTH = AN INTEGER VARIABLE CONTAINING
C                                THE (FULL) WIDTH OF THE INPUT LINE
C                                (THAT IS, THE NUMBER OF COLUMNS)
C     OUTPUT ARGUMENTS--IFOUNZ = A HOLLERITH ARRAY
C                                WITH THE VALUE 'YES'
C                                IF THE SUBSTRING WAS FOUND;
C                                AND THE VALUE 'NO'
C                                IF THE SUBSTRING WAS NOT FOUND.
C                     --IBEGIN = AN INTEGER ARRAY WITH
C                                THE START COLUMN OF THE FOUND SUBSTRING
C                     --IEND   = AN INTEGER ARRAY WITH
C                                THE STOP COLUMN OF THE FIUND SUBSTRING.
C                     --ITYPE  = A HOLLERITH ARRAY
C                                WITH THE VALUE 'WORD' IF THE SUBSTRING CONTAINS
C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
C                                AND WITH THE VALUE 'NUMB' IF THE SUBSTRING CO
C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
C                                (WITH INTERMITTENT BLANKS IGNORED).
C                     --IHOL   = AN HOLLERITH ARRAY
C                                CONTAINING THE PACKED (FIRST 4 CHARACTERS) VERS
C                                OF THE FOUND SUBSTRING.
C                     --IHOL2  = AN HOLLERITH ARRAY
C                                CONTAINING THE PACKED (NEXT 4 CHARACTERS) VERSI
C                                OF THE FOUND SUBSTRING.
C                     --INT1   = AN INTEGER ARRAY
C                                CONTAINING THE INTEGER REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND SUBSTRING.
C                     --FLOAT1 = AN FLOATING POINT ARRAY
C                                CONTAINING THE FLOATING POINT REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND SUBSTRING.
C                     --IERRO1 = AN HOLLERITH ARRAY
C                                WITH THE VALUE 'NO' IF
C                                NO ERROR HAS BEEN ENCOUNTERED,
C                                AND THE VALUE 'YES' IF AN
C                                ERROR HAS BEEN ENCOUNTERED.
C                     --NUMCL  = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF COMPONENTS
C                                ON THE LEFT SIDE
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --NUMPL  = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF PARENTHESES (LEFT + RIGHT)
C                                ON THE LEFT SIDE
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --NUMAOL = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF ARITHMETIC OPERATIONS
C                                ON THE LEFT SIDE
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --ITYW1L = A HOLLERITH VARIABLE CONTAINING THE
C                                TYPE ('WORD' VERSUS 'NUMB')
C                                FOR THE FIRST WORD
C                                (THAT IS, THE VARIABLE
C                                OR PARAMETER NAME)
C                                ON THE LEFT SIDE
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --ITYW2L = A HOLLERITH VARIABLE CONTAINING THE
C                                TYPE ('WORD' VERSUS 'NUMB')
C                                FOR THE SECOND WORD
C                                (THAT IS, THE ARGUMENT)
C                                ON THE LEFT SIDE
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --INLI1L = A HOLLERITH VARIABLE CONTAINING THE
C                                ANSWER ('YES' VERSUS 'NO')
C                                TO THE QUESTION AS TO WHETHER
C                                THE FIRST WORD ON THE LEFT
C                                (THAT IS, THE VARIABLE
C                                OR PARAMETER NAME)
C                                IS ALREADY EXISTENT IN THE
C                                INTERNAL DATAPLOT NAME LIST
C                                (NOT COUNTING LET OR THE = SIGN).
C                     --NUMCR  = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF COMPONENTS
C                                ON THE RIGHT SIDE
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C                     --NUMPR  = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF PARENTHESES (RIGHT + RIGHT)
C                                ON THE RIGHT SIDE
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C                     --NUMAOR = AN INTEGER VARIABLE CONTAINING THE
C                                NUMBER OF ARITHMETIC OPERATIONS
C                                ON THE RIGHT SIDE
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C                     --ITYW1R = A HOLLERITH VARIABLE CONTAINING THE
C                                TYPE ('WORD' VERSUS 'NUMB')
C                                FOR THE FIRST WORD
C                                (THAT IS, THE VARIABLE
C                                OR PARAMETER NAME)
C                                ON THE RIGHT SIDE
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C                     --ITYW2R = A HOLLERITH VARIABLE CONTAINING THE
C                                TYPE ('WORD' VERSUS 'NUMB')
C                                FOR THE SECOND WORD
C                                (THAT IS, THE ARGUMENT)
C                                ON THE RIGHT SIDE
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C                     --INLI1R = A HOLLERITH VARIABLE CONTAINING THE
C                                ANSWER ('YES' VERSUS 'NO')
C                                TO THE QUESTION AS TO WHETHER
C                                THE FIRST WORD ON THE RIGHT
C                                (THAT IS, THE VARIABLE
C                                OR PARAMETER NAME)
C                                IS ALREADY EXISTENT IN THE
C                                INTERNAL DATAPLOT NAME LIST
C                                (NOT COUNTING THE = SIGN OR SUBSET OR FOR).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1978
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1983.
C     UPDATED         --DECEMBER  1988.  ELIM. SPUR. ERROR MESS. FOR IFRINGE
C     UPDATED         --JANAURY   1989.  IANS(IENDP) WITH IENDP = 0 (ALAN)
C     UPDATED         --NOVEMBER  1989.  FIX IANS(IENDP=0) (NELSON)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IUSE
      CHARACTER*4 IFOUNZ
      CHARACTER*4 ITYPE
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERRO1
      CHARACTER*4 ITYW1L
      CHARACTER*4 ICAT1L
      CHARACTER*4 INLI1L
      CHARACTER*4 ITYW2L
      CHARACTER*4 ITYW1R
      CHARACTER*4 ICAT1R
      CHARACTER*4 INLI1R
      CHARACTER*4 ITYW2R
C
      CHARACTER*4 ISTRIN
      CHARACTER*4 ISTRI2
      CHARACTER*4 INEX
      CHARACTER*4 IVARL
      CHARACTER*4 IVARL2
      CHARACTER*4 IVARR
      CHARACTER*4 IVARR2
      CHARACTER*4 IQUAL
      CHARACTER*4 IHSTAT
      CHARACTER*4 IHSTA2
      CHARACTER*4 IHMAN
      CHARACTER*4 IHMAN2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
C
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IN(*)
C
      DIMENSION IFOUNZ(*)
      DIMENSION IBEGIN(*)
      DIMENSION IEND(*)
      DIMENSION ITYPE(*)
      DIMENSION IHOL(*)
      DIMENSION IHOL2(*)
      DIMENSION INT1(*)
      DIMENSION FLOAT1(*)
      DIMENSION IERRO1(*)
C
      DIMENSION IHMAN(10)
      DIMENSION IHMAN2(10)
      DIMENSION IHSTAT(25)
      DIMENSION IHSTA2(25)
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-----DATA STATEMENTS-------------------------------------------------
C
      DATA NUMMAN/8/
C
      DATA IHMAN(1),IHMAN2(1)/'SORT','    '/
      DATA IHMAN(2),IHMAN2(2)/'RANK','    '/
      DATA IHMAN(3),IHMAN2(3)/'CODE','    '/
      DATA IHMAN(4),IHMAN2(4)/'DIST','INCT'/
      DATA IHMAN(5),IHMAN2(5)/'SEQU','ENTI'/
      DATA IHMAN(6),IHMAN2(6)/'CUMU','LATI'/
      DATA IHMAN(7),IHMAN2(7)/'CUMU','LATI'/
      DATA IHMAN(8),IHMAN2(8)/'CUMU','LATI'/
C
      DATA NUMSTA/22/
C
      DATA IHSTAT(1),IHSTA2(1)/'SIZE','    '/
      DATA IHSTAT(2),IHSTA2(2)/'NUMB','ER  '/
      DATA IHSTAT(3),IHSTA2(3)/'SUM ','    '/
      DATA IHSTAT(4),IHSTA2(4)/'MIDR','ANGE'/
      DATA IHSTAT(5),IHSTA2(5)/'MEAN','    '/
      DATA IHSTAT(6),IHSTA2(6)/'AVER','AGE '/
      DATA IHSTAT(7),IHSTA2(7)/'MIDM','EAN '/
      DATA IHSTAT(8),IHSTA2(8)/'MEDI','AN  '/
      DATA IHSTAT(9),IHSTA2(9)/'STAN','ARD '/
      DATA IHSTAT(10),IHSTA2(10)/'VARI','ANCE'/
      DATA IHSTAT(11),IHSTA2(11)/'RELA','TIVE'/
      DATA IHSTAT(12),IHSTA2(12)/'RANG','E   '/
      DATA IHSTAT(13),IHSTA2(13)/'MINI','MUM '/
      DATA IHSTAT(14),IHSTA2(14)/'MAXI','MUM '/
      DATA IHSTAT(15),IHSTA2(15)/'STAN','DARD'/
      DATA IHSTAT(16),IHSTA2(16)/'SKEW','NESS'/
      DATA IHSTAT(17),IHSTA2(17)/'STAN','DARD'/
      DATA IHSTAT(18),IHSTA2(18)/'KURT','OSIS'/
      DATA IHSTAT(19),IHSTA2(19)/'AUTO','CORR'/
      DATA IHSTAT(20),IHSTA2(20)/'STAN','DARD'/
      DATA IHSTAT(21),IHSTA2(21)/'CORR','ELAT'/
      DATA IHSTAT(22),IHSTA2(22)/'RANK','    '/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTY'
      ISUBN2='P2  '
C
      IERROR='NO'
C
      IMAXR=0
C
      IQUAL='UNKN'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTYP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IANS(I),I=1,IWIDTH)
   54 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO100I=1,30
      IFOUNZ(I)='NO'
      IBEGIN(I)=-1
      IEND(I)=-1
      ITYPE(I)='9999'
      IHOL(I)='9999'
      IHOL2(I)='9999'
      INT1(I)=-999999
      FLOAT1(I)=-999999.0
      IERRO1(I)='NO'
  100 CONTINUE
C
      NUMCL=0
      NUMPL=0
      NUMAOL=0
      ITYW1L='9999'
      ICAT1L='9999'
      INLI1L='9999'
      ITYW2L='9999'
      NUMCR=0
      NUMPR=0
      NUMAOR=0
      ITYW1R='9999'
      ICAT1R='9999'
      INLI1R='9999'
      ITYW2R='9999'
C
C               ****************************************************************
C               **  STEP 2--
C               **  EXAMINE THE LEFT-HAND SIDE OF EXPRESSION.
C               **  DETERMINE IF PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN
C               **  HAS PARENTHESES.
C               **  IF IT HAS PARENTHESES, THIS MEANS THAT WE WILL BE
C               **  DEFINING    PART     OF A VARIABLE.
C               **  COMPONENT 1  = LET
C               **  COMPONENT 2  = VARIABLE NAME
C               **  COMPONENT 3  = (                             (IF IT EXISTS)
C               **  COMPONENT 4  = ARGUMENT (I.E., ROW OF TABLE) (IF IT EXISTS)
C               **  COMPONENT 5  = )                             (IF IT EXISTS)
C               **  COMPONENT 6  = =
C               ****************************************************************
C
C     MOST GENERAL FORM--LET X(I) = XXX FOR I = A B C
C                      --LET X(I) = XXX SUBSET XX A B
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 2.1--SEARCH FOR LET.
C
      ISTAR1=1
      ISTOP1=IWIDTH
      ISTRIN='LET'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(1),IBEGIN(1),IEND(1),
     1      ITYPE(1),IHOL(1),IHOL2(1),INT1(1),FLOAT1(1),IERRO1(1))
      IF(IFOUNZ(1).EQ.'YES')GOTO2190
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2190 CONTINUE
C
C     STEP 2.2--SEARCH FOR = SIGN.
C
      ISTAR1=IEND(1)+1
      ISTOP1=IWIDTH
      ISTRIN='='
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(6),IBEGIN(6),IEND(6),
     1      ITYPE(6),IHOL(6),IHOL2(6),INT1(6),FLOAT1(6),IERRO1(6))
      IF(IFOUNZ(6).EQ.'YES')GOTO2290
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C     STEP 2.3--SEARCH FOR LEFT-HAND SIDE (;
C     SEARCH BETWEEN LET AND =.
C
      ISTAR1=IEND(1)+1
      ISTOP1=IBEGIN(6)-1
      ISTRIN='('
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(3),IBEGIN(3),IEND(3),
     1      ITYPE(3),IHOL(3),IHOL2(3),INT1(3),FLOAT1(3),IERRO1(3))
      IF(IFOUNZ(3).EQ.'YES')GOTO2390
      GOTO2500
 2390 CONTINUE
C
C     STEP 2.4--SEARCH FOR LEFT-HAND SIDE );
C     SEARCH BETWEEN ( AND =.
C
      ISTAR1=IEND(3)+1
      ISTOP1=IBEGIN(6)-1
      ISTRIN=')'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(5),IBEGIN(5),IEND(5),
     1      ITYPE(5),IHOL(5),IHOL2(5),INT1(5),FLOAT1(5),IERRO1(5))
      IF(IFOUNZ(5).EQ.'YES')GOTO2490
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2490 CONTINUE
      GOTO2600
C
C     STEP 2.5--IF NO LEFT-HAND SIDE PARENTHESES FOUND,
C     EXTRACT VARIABLE NAME;
C     SEARCH BETWEEN LET AND =.
C
 2500 CONTINUE
      ISTAR1=IEND(1)+1
      ISTOP1=IBEGIN(6)
      ISTRIN='!;='
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(2),IBEGIN(2),IEND(2),
     1      ITYPE(2),IHOL(2),IHOL2(2),INT1(2),FLOAT1(2),IERRO1(2))
      IF(IFOUNZ(2).EQ.'YES')GOTO2590
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2590 CONTINUE
      GOTO2800
C
C     STEP 2.6--IF LEFT-HAND SIDE PARENTHESES FOUND,
C     FIRST EXTRACT VARIABLE NAME;
C     SEARCH BETWEEN LET AND (.
C
 2600 CONTINUE
      ISTAR1=IEND(1)+1
      ISTOP1=IBEGIN(3)
      ISTRIN='!;('
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(2),IBEGIN(2),IEND(2),
     1      ITYPE(2),IHOL(2),IHOL2(2),INT1(2),FLOAT1(2),IERRO1(2))
      IF(IFOUNZ(2).EQ.'YES')GOTO2690
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2690 CONTINUE
C
C     STEP 2.7--ALSO IF LEFT-HAND SIDE PARENTHESES FOUND,
C     SEARCH FOR LEFT-HAND SIDE ARGUMENT NAME OR VALUE;
C     SEARCH BETWEEN ( AND ).
C
      ISTAR1=IEND(3)
      ISTOP1=IBEGIN(5)
      ISTRIN='(;)'
      ISTRI2='    '
      INEX='EE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(4),IBEGIN(4),IEND(4),
     1      ITYPE(4),IHOL(4),IHOL2(4),INT1(4),FLOAT1(4),IERRO1(4))
      IF(IFOUNZ(4).EQ.'YES')GOTO2790
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 2790 CONTINUE
      K=4
      IF(ITYPE(K).EQ.'WORD')
     1CALL DPCHEC(K,IHOL,IHOL2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1INT1,FLOAT1,IBUGA3,IERROR)
C
 2800 CONTINUE
C
C               *******************************************************
C               **  STEP 3--                                         **
C               **  EXAMINE THE RIGHT-HAND SIDE OF EXPRESSION.       **
C               **  DETERMINE WHICH OF THE 3 CASES WE HAVE--         **
C               **      1) LET X(I) =                                **
C               **      2) LET X(I) =       SUBSET XX  A  B          **
C               **      3) LET X(I) =       FOR XX = A  B  C         **
C               **  IF CASE 1 (THE NON-SUBSET AND NON-FOR CASE),     **
C               **  SEARCH FOR COMPONENTS 7, 8, 9, AND 10--          **
C               **  COMPONENT 7  = VARIABLE NAME                     **
C               **  COMPONENT 8  = (                                 **
C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)  **
C               **  COMPONENT 10 = )                                 **
C               **  IF CASE 2 (THE SUBSET CASE), JUMP TO STEP 4      **
C               **  IF CASE 3 (THE FOR CASE), JUMP TO STEP 5.        **
C               *******************************************************
C
 3000 CONTINUE
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 3.1A--SEARCH FOR SUBSET.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='SUBS'
      ISTRI2='ET  '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(11),IBEGIN(11),IEND(11),
     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE SUBSETXX
CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
      IENDP=IEND(11)+1
      IF(IENDP.LE.0)IFOUNZ(11)='NO'
      IF(IENDP.LE.0)GOTO3119
      IF(IFOUNZ(11).EQ.'YES'.AND.
     1   IENDP.LE.ISTOP1.AND.
     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
      IF(IFOUNZ(11).EQ.'YES')GOTO4000
 3119 CONTINUE
C
C     STEP 3.1B--SEARCH FOR EXCEPT.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='EXCE'
      ISTRI2='PT  '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(11),IBEGIN(11),IEND(11),
     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE EXCEPTXX
CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
      IENDP=IEND(11)+1
      IF(IENDP.LE.0)IFOUNZ(11)='NO'
      IF(IENDP.LE.0)GOTO3129
      IF(IFOUNZ(11).EQ.'YES'.AND.
     1   IENDP.LE.ISTOP1.AND.
     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
      IF(IFOUNZ(11).EQ.'YES')GOTO4000
 3129 CONTINUE
C
C     STEP 3.1C--SEARCH FOR FOR.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='FOR'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(21),IBEGIN(21),IEND(21),
     1      ITYPE(21),IHOL(21),IHOL2(21),INT1(21),FLOAT1(21),IERRO1(21))
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE FORTUNE
CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
      IENDP=IEND(21)+1
      IF(IENDP.LE.0)IFOUNZ(21)='NO'
      IF(IENDP.LE.0)GOTO3139
      IF(IFOUNZ(21).EQ.'YES'.AND.
     1   IENDP.LE.ISTOP1.AND.
     1   IANS(IENDP).NE.' ')IFOUNZ(21)='NO'
      IF(IFOUNZ(21).EQ.'YES')GOTO5000
 3139 CONTINUE
C
C     STEP 3.1D--SEARCH FOR IF.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='IF  '
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(11),IBEGIN(11),IEND(11),
     1      ITYPE(11),IHOL(11),IHOL2(11),INT1(11),FLOAT1(11),IERRO1(11))
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1988 TO AVOID
CCCCC SPURIOUS ERROR MESSAGES WITH A LONG VARIABLE NAME LIKE IFRING
CCCCC THE SECTION WAS CORRECTED ALSO IN JANUARY 1988 AND NOVEMBER 1989
      IENDP=IEND(11)+1
      IF(IENDP.LE.0)IFOUNZ(11)='NO'
      IF(IENDP.LE.0)GOTO3149
      IF(IFOUNZ(11).EQ.'YES'.AND.
     1   IENDP.LE.ISTOP1.AND.
     1   IANS(IENDP).NE.' ')IFOUNZ(11)='NO'
      IF(IFOUNZ(11).EQ.'YES')GOTO4000
 3149 CONTINUE
C
C     STEP 3.2--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE (;
C     SEARCH BETWEEN = AND END OF LINE.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='('
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(8),IBEGIN(8),IEND(8),
     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
      IF(IFOUNZ(8).EQ.'YES')GOTO3290
      GOTO3400
 3290 CONTINUE
C
C     STEP 3.3--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE );
C     SEARCH BETWEEN ( AND END OF LINE.
C
      ISTAR1=IEND(8)+1
      ISTOP1=IWIDTH
      ISTRIN=')'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(10),IBEGIN(10),IEND(10),
     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
      IF(IFOUNZ(10).EQ.'YES')GOTO3390
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 3390 CONTINUE
      GOTO3500
C
C     STEP 3.4--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
C     EXTRACT VARIABLE NAME OR VALUE;
C     SEARCH BETWEEN = AND END OF LINE.
C     ALSO, TO HANDLE THE COLUMN NAMING CASE
C     (E.G., LET X = COLUMN 1),
C     CHECK TO SEE IF ANOTHER ITEM
C     FOLLOWS THE VARIABLE NAME OR VALUE.
C     AND FURTERMORE, TO HANDLE THE DATA GENERATION CASE
C     (E.G., LET X = 1 1 10),
C     CHECK TO SEE OF 2 ITEMS
C     FOLLOW THE FIRST VALUE.
C
 3400 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO3410
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
C
 3410 CONTINUE
      ISTAR1=IEND(7)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(8),IBEGIN(8),IEND(8),
     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
      IF(IFOUNZ(8).EQ.'YES')GOTO3420
      GOTO3900
C
 3420 CONTINUE
      ISTAR1=IEND(8)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(9),IBEGIN(9),IEND(9),
     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
      GOTO3900
C
C     STEP 3.5--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     FIRST EXTRACT VARIABLE NAME;
C     SEARCH BETWEEN = AND (.
C
 3500 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(8)
      ISTRIN='!;('
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO3590
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 3590 CONTINUE
C
C     STEP 3.6--IF NEITHER SUBSET NOR FOR HAVE BEEN FOUND,
C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
C     SEARCH BETWEEN ( AND ).
C
      ISTAR1=IEND(8)
      ISTOP1=IBEGIN(10)
      ISTRIN='(;)'
      ISTRI2='    '
      INEX='EE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(9),IBEGIN(9),IEND(9),
     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
      IF(IFOUNZ(9).EQ.'YES')GOTO3690
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 3690 CONTINUE
      K=9
      IF(ITYPE(K).EQ.'WORD')
     1CALL DPCHEC(K,IHOL,IHOL2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1INT1,FLOAT1,IBUGA3,IERROR)
C
 3900 CONTINUE
      GOTO6000
C
C               **********************************************************
C               **  STEP 4--                                            **
C               **  FOR THE CASE WHEN HAVE     LET X(I) =               **
C               **  EXAMINE THE RIGHT-HAND SIDE FOR    SUBSET XX  A  B  **
C               **  COMPONENT 7  = VARIABLE NAME                        **
C               **  COMPONENT 8  = (                                    **
C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)     **
C               **  COMPONENT 10 = )                                    **
C               **  COMPONENT 11 = SUBSET                               **
C               **  COMPONENT 12 = LOWER LIMIT             OF SUBSET    **
C               **  COMPONENT 13 = UPPER LIMIT (IF EXISTS) OF SUBSET    **
C               **********************************************************
C
 4000 CONTINUE
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 4.2--IF SUBSET HAS BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE (;
C     SEARCH BETWEEN = AND SUBSET.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(11)-1
      ISTRIN='('
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(8),IBEGIN(8),IEND(8),
     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
      IF(IFOUNZ(8).EQ.'YES')GOTO4090
      GOTO4400
 4090 CONTINUE
C
C     STEP 4.3--IF SUBSET HAS BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE );
C     SEARCH BETWEEN ( AND SUBSET.
C
      ISTAR1=IEND(8)+1
      ISTOP1=IBEGIN(11)-1
      ISTRIN=')'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(10),IBEGIN(10),IEND(10),
     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
      IF(IFOUNZ(10).EQ.'YES')GOTO4390
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4390 CONTINUE
      GOTO4500
C
C     STEP 4.4--IF SUBSET HAS BEEN FOUND,
C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
C     EXTRACT VARIABLE NAME OR VALUE;
C     SEARCH BETWEEN = AND SUBSET.
C
 4400 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(11)
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO4490
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4490 CONTINUE
      GOTO4700
C
C     STEP 4.5--IF SUBSET HAS BEEN FOUND,
C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     FIRST EXTRACT VARIABLE NAME;
C     SEARCH BETWEEN = AND (.
C
 4500 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(8)
      ISTRIN='!;('
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO4590
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4590 CONTINUE
C
C     STEP 4.6--IF SUBSET HAS BEEN FOUND,
C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
C     SEARCH BETWEEN ( AND ).
C
      ISTAR1=IEND(8)
      ISTOP1=IBEGIN(10)
      ISTRIN='(;)'
      ISTRI2='    '
      INEX='EE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(9),IBEGIN(9),IEND(9),
     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
      IF(IFOUNZ(9).EQ.'YES')GOTO4690
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4690 CONTINUE
      K=9
      IF(ITYPE(K).EQ.'WORD')
     1CALL DPCHEC(K,IHOL,IHOL2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1INT1,FLOAT1,IBUGA3,IERROR)
C
C     STEP 4.7--IF SUBSET HAS BEEN FOUND,
C     SEARCH FOR VARIABLE NAME AFTER SUBSET;
C     SEARCH BETWEEN SUBSET AND THE END OF THE LINE.
C
 4700 CONTINUE
      ISTAR1=IEND(11)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(12),IBEGIN(12),IEND(12),
     1      ITYPE(12),IHOL(12),IHOL2(12),INT1(12),FLOAT1(12),IERRO1(12))
      IF(IFOUNZ(12).EQ.'YES')GOTO4790
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4790 CONTINUE
C
C     STEP 4.8--IF SUBSET HAS BEEN FOUND,
C     SEARCH FOR LOWER LIMIT VALUE AFTER     SUBSET XXX
C     SEARCH BETWEEN VARIABLE NAME AND THE END OF THE LINE.
C
      ISTAR1=IEND(12)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(13),IBEGIN(13),IEND(13),
     1      ITYPE(13),IHOL(13),IHOL2(13),INT1(13),FLOAT1(13),IERRO1(13))
      IF(IFOUNZ(13).EQ.'YES')GOTO4890
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 4890 CONTINUE
C
C     STEP 4.9--IF SUBSET HAS BEEN FOUND,
C     SEARCH FOR UPPER LIMIT (IF EXISTENT) AFTER     SUBSET XXX
C     SEARCH BETWEEN LOWER LIMIT AND THE END OF THE LINE.
C
      ISTAR1=IEND(13)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(14),IBEGIN(14),IEND(14),
     1      ITYPE(14),IHOL(14),IHOL2(14),INT1(14),FLOAT1(14),IERRO1(14))
 4900 CONTINUE
      GOTO6000
C
C               **********************************************************
C               **  STEP 5--                                            **
C               **  FOR THE CASE WHEN HAVE     LET X(I) =               **
C               **  EXAMINE THE RIGHT-HAND SIDE FOR    FOR I = A  B  C  **
C               **  COMPONENT 7  = VARIABLE NAME                        **
C               **  COMPONENT 8  = (                                    **
C               **  COMPONENT 9  = ARGUMENT (THAT IS, ROW OF TABLE)     **
C               **  COMPONENT 10 = )                                    **
C               **  COMPONENT 21 = FOR                                  **
C               **  COMPONENT 22 = =                                    **
C               **  COMPONENT 23 = START     VALUE FOR DUMMY INDEX      **
C               **  COMPONENT 24 = INCREMENT VALUE FOR DUMMY INDEX      **
C               **  COMPONENT 25 = STOP      VALUE FOR SUMMY INDEX      **
C               **********************************************************
C
 5000 CONTINUE
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 5.2--IF FOR HAS BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE (;
C     SEARCH BETWEEN = AND FOR.
C
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(21)-1
      ISTRIN='('
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(8),IBEGIN(8),IEND(8),
     1      ITYPE(8),IHOL(8),IHOL2(8),INT1(8),FLOAT1(8),IERRO1(8))
      IF(IFOUNZ(8).EQ.'YES')GOTO5290
      GOTO5400
 5290 CONTINUE
C
C     STEP 5.3--IF FOR HAS BEEN FOUND,
C     SEARCH FOR RIGHT-HAND SIDE );
C     SEARCH BETWEEN ( AND FOR.
C
      ISTAR1=IEND(8)+1
      ISTOP1=IBEGIN(21)-1
      ISTRIN=')'
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(10),IBEGIN(10),IEND(10),
     1      ITYPE(10),IHOL(10),IHOL2(10),INT1(10),FLOAT1(10),IERRO1(10))
      IF(IFOUNZ(10).EQ.'YES')GOTO5390
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5390 CONTINUE
      GOTO5500
C
C     STEP 5.4--IF FOR HAS BEEN FOUND,
C     IF NO RIGHT-HAND SIDE PARENTHESES FOUND,
C     EXTRACT VARIABLE NAME OR VALUE;
C     SEARCH BETWEEN = AND FOR.
C
 5400 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(21)
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO5490
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5490 CONTINUE
      GOTO5700
C
C     STEP 5.5--IF FOR HAS BEEN FOUND,
C     IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     FIRST EXTRACT VARIABLE NAME;
C     SEARCH BETWEEN = AND (.
C
 5500 CONTINUE
      ISTAR1=IEND(6)+1
      ISTOP1=IBEGIN(8)
      ISTRIN='!;('
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(7),IBEGIN(7),IEND(7),
     1      ITYPE(7),IHOL(7),IHOL2(7),INT1(7),FLOAT1(7),IERRO1(7))
      IF(IFOUNZ(7).EQ.'YES')GOTO5590
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5590 CONTINUE
C
C     STEP 5.6--IF FOR HAS BEEN FOUND,
C     ALSO IF RIGHT-HAND SIDE PARENTHESES FOUND,
C     SEARCH FOR RIGHT-HAND SIDE ARGUMENT NAME OR VALUE;
C     SEARCH BETWEEN ( AND ).
C
      ISTAR1=IEND(8)
      ISTOP1=IBEGIN(10)
      ISTRIN='(;)'
      ISTRI2='    '
      INEX='EE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(9),IBEGIN(9),IEND(9),
     1      ITYPE(9),IHOL(9),IHOL2(9),INT1(9),FLOAT1(9),IERRO1(9))
      IF(IFOUNZ(9).EQ.'YES')GOTO5690
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5690 CONTINUE
      K=9
      IF(ITYPE(K).EQ.'WORD')
     1CALL DPCHEC(K,IHOL,IHOL2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1INT1,FLOAT1,IBUGA3,IERROR)
C
C     STEP 5.7--IF FOR HAS BEEN FOUND,
C     SEARCH FOR VARIABLE NAME AFTER FOR;
C     SEARCH BETWEEN FOR AND THE END OF THE LINE.
C
 5700 CONTINUE
      ISTAR1=IEND(21)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(22),IBEGIN(22),IEND(22),
     1      ITYPE(22),IHOL(22),IHOL2(22),INT1(22),FLOAT1(22),IERRO1(22))
      IF(IFOUNZ(22).EQ.'YES')GOTO5790
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5790 CONTINUE
C
C     STEP 5.8--IF FOR HAS BEEN FOUND,
C     SEARCH FOR = SIGN AFTER    FOR XXX
C     SEARCH BETWEEN VARIABLE NAME AND END OF LINE.
C
      ISTAR1=IEND(22)+1
      ISTOP1=IWIDTH
      ISTRIN='='
      ISTRI2='    '
      INEX='II'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(23),IBEGIN(23),IEND(23),
     1      ITYPE(23),IHOL(23),IHOL2(23),INT1(23),FLOAT1(23),IERRO1(23))
      IF(IFOUNZ(23).EQ.'YES')GOTO5890
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5890 CONTINUE
C
C     STEP 5.9--IF FOR HAS BEEN FOUND,
C     SEARCH FOR START VALUE AFTER     FOR XXX =
C     SEARCH BETWEEN = AND THE END OF THE LINE.
C
      ISTAR1=IEND(23)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(24),IBEGIN(24),IEND(24),
     1      ITYPE(24),IHOL(24),IHOL2(24),INT1(24),FLOAT1(24),IERRO1(24))
      IF(IFOUNZ(24).EQ.'YES')GOTO5990
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5990 CONTINUE
C
C     STEP 5.10--IF FOR HAS BEEN FOUND,
C     SEARCH FOR INCREMENT VALUE AFTER     FOR XXX =
C     SEARCH BETWEEN START VALUE AND THE END OF THE LINE.
C
      ISTAR1=IEND(24)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(25),IBEGIN(25),IEND(25),
     1      ITYPE(25),IHOL(25),IHOL2(25),INT1(25),FLOAT1(25),IERRO1(25))
      IF(IFOUNZ(25).EQ.'YES')GOTO5930
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5930 CONTINUE
C
C     STEP 5.11--IF FOR HAS BEEN FOUND,
C     SEARCH FOR STOP VALUE AFTER     FOR XXX =
C     SEARCH BETWEEN INCREMENT VALUE AND THE END OF THE LINE.
C
      ISTAR1=IEND(25)+1
      ISTOP1=IWIDTH
      ISTRIN='!;:'
      ISTRI2='    '
      INEX='IE'
      CALL DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,IBUGA3,
     1      IFOUNZ(26),IBEGIN(26),IEND(26),
     1      ITYPE(26),IHOL(26),IHOL2(26),INT1(26),FLOAT1(26),IERRO1(26))
      IF(IFOUNZ(26).EQ.'YES')GOTO5950
      CALL DPLETE(IANS,IWIDTH)
      IERROR='YES'
      GOTO9000
 5950 CONTINUE
      GOTO6000
C
C               ************************************************
C               **  STEP 6--                                  **
C               **  DETERMINE VARIOUS SUMMARY VARIABLES       **
C               **  FOR THE LEFT SIDE                         **
C               **  OF THE COMMAND LINE                       **
C               **  WHICH WILL BE HELPFUL BACK IN DPLET       **
C               **  FOR BRANCHING TO THE CORRECT              **
C               **  TYPE OF OPERATION.                        **
C               **  NOTE THAT THE    LEFT SIDE                    **
C               **  WILL BE FROM     LET                      **
C               **  TO THE           = SIGN                   **
C               **  BUT WILL NOT INCLUDE EITHER.              **
C               ************************************************
C
 6000 CONTINUE
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 6.0--
C     DETERMINE THE LIMITS OF THE LEFT SIDE
C
      IMINL=0
      IF(IFOUNZ(1).EQ.'YES')IMINL=IEND(1)+1
C
      IMAXL=0
      IF(IFOUNZ(6).EQ.'YES')IMAXL=IBEGIN(6)-1
C
      IF(IMINL.LE.0)GOTO6900
      IF(IMAXL.LE.0)GOTO6900
      IF(IMINL.GT.IMAXL)GOTO6900
C
C     STEP 6.1--
C     DETERMINE THE NUMBER OF COMPONENTS ON THE LEFT.
C     A COMPONET HERE = A WORD OR A PARENTHESIS.
C
      ISUM=0
      IMIN=2
      IMAX=5
      DO6100I=IMIN,IMAX
      IF(IFOUNZ(I).EQ.'YES')ISUM=ISUM+1
 6100 CONTINUE
      NUMCL=ISUM
C
C     STEP 6.2--
C     DETERMINE THE NUMBER OF PARENTHESES (LEFT + RIGHT).
C
      ISUM=0
      IMIN=IMINL
      IMAX=IMAXL
      DO6200I=IMIN,IMAX
      IF(IANS(I).EQ.'('.OR.IANS(I).EQ.')')ISUM=ISUM+1
 6200 CONTINUE
 6250 CONTINUE
      NUMPL=ISUM
C
C     STEP 6.3--
C     DETERMINE THE NUMBER OF ARITHMETIC OPERATIONS
C     +  -  *  /      ON THE LEFT
C     (IT SHOULD BE 0).
C     NOTE THAT THE ARITHMETIC OPERATION   **
C     WILL BE LUMPED IN WITH    *    .
C
      ISUM=0
      IMIN=IMINL
      IMAX=IMAXL
      DO6300I=IMIN,IMAX
      IF(IANS(I).EQ.'+'.OR.IANS(I).EQ.'-'.
     1OR.IANS(I).EQ.'*'.OR.IANS(I).EQ.'/')ISUM=ISUM+1
 6300 CONTINUE
 6350 CONTINUE
      NUMAOL=ISUM
C
C     STEP 6.4--
C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
C     FOR THE FIRST WORD ON THE LEFT.
C     THIS SHOULD BE THE VARIABLE OR PARAMETER
C     DESIGNATION,
C     AND IT SHOULD BE A 'WORD'.
C
      ITYW1L=ITYPE(2)
C
C     STEP 6.5--
C     DETERMINE IF FIRST WORD ON THE LEFT
C     IS ALREADY IN THE NAME LIST OR NOT.
C
      INLI1L='NO'
      IVARL=IHOL(2)
      IVARL2=IHOL2(2)
      DO6500I=1,NUMNAM
      IF(IVARL.EQ.IHNAME(I).AND.IVARL2.EQ.IHNAM2(I))INLI1L='YES'
 6500 CONTINUE
C
C     STEP 6.6--
C     DETERMINE IF FIRST WORD ON THE LEFT
C     IS IN THE VARIABLE/PARAMETER NAME LIST, OR
C     IS A COLUMN NAMING (I.E., THE WORD 'COLU' OR 'COL', OR
C     IS A DATA MANIPULATION FUNCTION, OR
C     IS A STATISTICAL CALCULATION FUNCTION
C     (SEARCH IS DONE IN THAT ORDER).
C
C
      ICAT1L='NONE'
      IVARL=IHOL(2)
      IVARL2=IHOL2(2)
C
 6610 CONTINUE
      IF(INLI1L.EQ.'YES'.AND.IVARL.NE.'COLU')GOTO6615
      IF(INLI1L.EQ.'YES'.AND.IVARL.NE.'COL ')GOTO6615
      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
     1IFOUNZ(3).EQ.'NO')GOTO6615
      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
     1IFOUNZ(3).EQ.'NO')GOTO6615
      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).NE.'NUMB')GOTO6615
      IF(INLI1L.EQ.'YES'.AND.IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).NE.'NUMB')GOTO6615
      GOTO6620
 6615 CONTINUE
      ICAT1L='VARP'
      GOTO6690
C
 6620 CONTINUE
      IF(IVARL.EQ.'COLU'.AND.IVARL2.EQ.'MN  '.AND.
     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).EQ.'NUMB')GOTO6625
      IF(IVARL.EQ.'COL '.AND.IVARL2.EQ.'    '.AND.
     1IFOUNZ(3).EQ.'YES'.AND.ITYPE(3).EQ.'NUMB')GOTO6625
      GOTO6630
 6625 CONTINUE
      ICAT1L='COL'
      GOTO6690
C
 6630 CONTINUE
      DO6632I=1,NUMMAN
      IF(IVARL.EQ.IHMAN(I).AND.IVARL2.EQ.IHMAN2(I))GOTO6635
 6632 CONTINUE
      GOTO6640
 6635 CONTINUE
      ICAT1L='MANI'
      GOTO6690
C
 6640 CONTINUE
      DO6642I=1,NUMSTA
      IF(IVARL.EQ.IHSTAT(I).AND.IVARL2.EQ.IHSTA2(I))GOTO6645
 6642 CONTINUE
      GOTO6690
 6645 CONTINUE
      ICAT1L='STAT'
      GOTO6690
C
 6690 CONTINUE
C
C     STEP 6.7--
C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
C     FOR THE SECOND WORD
C     (AS OPPOSED TO THE SECOND COMPONENT)
C     ON THE LEFT.
C     IF EXISTENT, THIS SHOULD BE THE ARGUMENT DESIGNATION
C     OF A VARIABLE,
C     AND IT MAY BE EITHER A 'WORD' OR A 'NUMB'.
C
      ITYW2L=ITYPE(4)
C
 6900 CONTINUE
C
C               *********************************************************
C               **  STEP 7--                                           **
C               **  DETERMINE VARIOUS SUMMARY VARIABLES                **
C               **  FOR THE RIGHT SIDE                                 **
C               **  OF THE COMMAND LINE                                **
C               **  WHICH WILL BE HELPFUL BACK IN DPLET                **
C               **  FOR BRANCHING TO THE CORRECT                       **
C               **  TYPE OF OPERATION.                                 **
C               **  NOTE THAT THE    RIGHT SIDE                            **
C               **  WILL BE FROM THE = SIGN                            **
C               **  TO THE           END OF THE LINE,                  **
C               **  OR TO AN         ISOLATED FOR,                     **
C               **  OR TO AN         ISOLATED SUBSET                   **
C               **  (WHICHEVER OF THE 3 IS SMALLEST).                  **
C               **  ALSO DETERMINE WHETHER THE QUALIFICATION           **
C               **  ON THE FAR RIGHT OF THE CARD IS                    **
C               **           1) BLANK (THAT IS, NO QUALIFICATION)      **
C               **           2) SUBSET                                 **
C               **           3) FOR                                    **
C               **  THE VARIABLE IQUAL WILL BE DEFINED IN              **
C               **  THIS REGARD                                        **
C               **  IQUAL WILL = 'NONE', 'FOR', 'SUBS', OR 'ERRO'.  **
C               *********************************************************
C
 7000 CONTINUE
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     STEP 7.0--
C     DETERMINE THE LIMITS OF THE    RIGHT SIDE
C
      IMINR=0
      IF(IFOUNZ(6).EQ.'YES')IMINR=IEND(6)+1
C
      IF(IFOUNZ(11).EQ.'YES'.AND.IFOUNZ(21).EQ.'YES')GOTO7020
      GOTO7030
C
 7020 CONTINUE
      WRITE(ICOUT,7021)
 7021 FORMAT('***** ERROR IN DPTYP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7022)
 7022 FORMAT('      BOTH FOR CASE AND SUBSET CASE FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7023)IWIDTH
 7023 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7024)
 7024 FORMAT('THE COMMAND LINE IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7025)(IANS(I),I=1,IWIDTH)
 7025 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IQUAL = 'ERRO'
      IMAXR=0
      GOTO7090
C
 7030 CONTINUE
      IF(IFOUNZ(11).EQ.'NO'.AND.IFOUNZ(21).EQ.'NO')IQUAL='NONE'
      IF(IFOUNZ(11).EQ.'YES')IQUAL='SUBS'
      IF(IFOUNZ(21).EQ.'YES')IQUAL='FOR'
      IF(IQUAL.EQ.'NONE')IMAXR=IWIDTH
      IF(IQUAL.EQ.'SUBS')IMAXR=IBEGIN(11)-1
      IF(IQUAL.EQ.'FOR')IMAXR=IBEGIN(21)-1
C
 7090 CONTINUE
      IF(IMINR.LE.0)GOTO7900
      IF(IMAXR.LE.0)GOTO7900
      IF(IMINR.GT.IMAXR)GOTO7900
C
C     STEP 7.1--
C     DETERMINE THE NUMBER OF COMPONENTS ON THE RIGHT.
C     A COMPONENT HERE = A WORD OR A PARENTHESIS.
C
      ISUM=0
      IMIN=7
      IMAX=10
      DO7100I=IMIN,IMAX
      IF(IFOUNZ(I).EQ.'YES')ISUM=ISUM+1
 7100 CONTINUE
      NUMCR=ISUM
C
C     STEP 7.2--
C     DETERMINE THE NUMBER OF PARENTHESES (LEFT + RIGHT).
C
      ISUM=0
      IMIN=IMINR
      IMAX=IMAXR
      DO7200I=IMIN,IMAX
      IF(IANS(I).EQ.'('.OR.IANS(I).EQ.')')ISUM=ISUM+1
 7200 CONTINUE
 7250 CONTINUE
      NUMPR=ISUM
C
C     STEP 7.3--
C     DETERMINE THE NUMBER OF ARITHMETIC OPERATIONS
C     +  -  *  /      ON THE RIGHT
C     (IT SHOULD BE 0).
C     NOTE THAT THE ARITHMETIC OPERATION   **
C     WILL BE LUMPED IN WITH    *    .
C
      ISUM=0
      IMIN=IMINR
      IMAX=IMAXR
      DO7300I=IMIN,IMAX
      IF(IANS(I).EQ.'+'.OR.IANS(I).EQ.'-'.
     1OR.IANS(I).EQ.'*'.OR.IANS(I).EQ.'/')ISUM=ISUM+1
 7300 CONTINUE
 7350 CONTINUE
      NUMAOR=ISUM
C
C     STEP 7.4--
C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
C     FOR THE FIRST WORD ON THE RIGHT.
C     THIS SHOULD BE THE VARIABLE OR PARAMETER
C     DESIGNATION,
C     AND IT SHOULD BE A 'WORD'.
C
      ITYW1R=ITYPE(7)
C
C     STEP 7.5--
C     DETERMINE IF FIRST WORD ON THE RIGHT
C     IS ALREADY IN THE NAME LIST OR NOT.
C
      INLI1R='NO'
      IVARR=IHOL(7)
      IVARR2=IHOL2(7)
      DO7500I=1,NUMNAM
      IF(IVARR.EQ.IHNAME(I).AND.IVARR2.EQ.IHNAM2(I))INLI1R='YES'
 7500 CONTINUE
C
C     STEP 7.6--
C     DETERMINE IF FIRST WORD ON THE RIGHT
C     IS IN THE VARIABLE/PARAMETER NAME LIST, OR
C     IS A COLUMN NAMING (I.E., THE WORD 'COLU' OR 'COL', OR
C     IS A DATA MANIPULATION FUNCTION, OR
C     IS A STATISTICAL CALCULATION FUNCTION
C     (SEARCH IS DONE IN THAT ORDER).
C
      ICAT1R='NONE'
      IVARR=IHOL(7)
      IVARR2=IHOL2(7)
C
 7610 CONTINUE
      IF(INLI1R.EQ.'YES'.AND.IVARR.NE.'COLU')GOTO7615
      IF(INLI1R.EQ.'YES'.AND.IVARR.NE.'COL ')GOTO7615
      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
     1IFOUNZ(8).EQ.'NO')GOTO7615
      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
     1IFOUNZ(8).EQ.'NO')GOTO7615
      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).NE.'NUMB')GOTO7615
      IF(INLI1R.EQ.'YES'.AND.IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).NE.'NUMB')GOTO7615
      GOTO7620
 7615 CONTINUE
      ICAT1R='VARP'
      GOTO7690
C
 7620 CONTINUE
      IF(IVARR.EQ.'COLU'.AND.IVARR2.EQ.'MN  '.AND.
     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).EQ.'NUMB')GOTO7625
      IF(IVARR.EQ.'COL '.AND.IVARR2.EQ.'    '.AND.
     1IFOUNZ(8).EQ.'YES'.AND.ITYPE(8).EQ.'NUMB')GOTO7625
      GOTO7630
 7625 CONTINUE
      ICAT1R='COL'
      GOTO7690
C
 7630 CONTINUE
      DO7632I=1,NUMMAN
      IF(IVARR.EQ.IHMAN(I).AND.IVARR2.EQ.IHMAN2(I))GOTO7635
 7632 CONTINUE
      GOTO7640
 7635 CONTINUE
      ICAT1R='MANI'
      GOTO7690
C
 7640 CONTINUE
      DO7642I=1,NUMSTA
      IF(IVARR.EQ.IHSTAT(I).AND.IVARR2.EQ.IHSTA2(I))GOTO7645
 7642 CONTINUE
      GOTO7690
 7645 CONTINUE
      ICAT1R='STAT'
      GOTO7690
C
 7690 CONTINUE
C
C     STEP 7.7--
C     DETERMINE THE TYPE ('NUMB' OR 'WORD')
C     FOR THE SECOND WORD
C     (AS OPPOSED TO THE SECOND COMPONENT)
C     ON THE RIGHT.
C     IF EXISTENT, THIS SHOULD BE THE ARGUMENT DESIGNATION
C     OF A VARIABLE,
C     AND IT MAY BE EITHER A 'WORD' OR A 'NUMB'.
C
      ITYW2R=ITYPE(9)
C
 7900 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('****** AT THE END      OF DPTYP2--')
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,30
      IF(18.LE.I.AND.I.LE.20)GOTO9020
      IF(I.GE.25)GOTO9020
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)
 9022 FORMAT('I--IFOUNZ,IBEGIN,IEND,',
     1'ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)I,IFOUNZ(I),IBEGIN(I),IEND(I),
     1ITYPE(I),IHOL(I),IHOL2(I),INT1(I),FLOAT1(I),IERRO1(I)
 9025 FORMAT(I3,'--',A4,2X,I2,2X,I2,4X,
     1A4,2X,A4,2X,A4,2X,I8,2X,D15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NUMCL,NUMPL,NUMAOL,ITYW1L,ITYW2L,INLI1L,ICAT1L
 9031 FORMAT('NUMCL,NUMPL,NUMAOL,ITYW1L,ITYW2L,INLI1L,ICAT1L = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)NUMCR,NUMPR,NUMAOR,ITYW1R,ITYW2R,INLI1R,ICAT1R
 9032 FORMAT('NUMCR,NUMPR,NUMAOR,ITYW1R,ITYW2R,INLI1R,ICAT1R = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      GOTO9090
C
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE DPTYP3(IANS,IWIDTH,ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX,
     1                  IBUGA3,
     1                  IFOUZ2,ISTAR2,ISTOP2,
     1                  ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO DPTY3C
C           AND HAS BEEN DUPLICATED ONLY FOR MAPPING PURPOSES.
C           DATE--JULY 7, 1978.
C
C     PURPOSE--SCAN THE CHARACTER ARRAY IANS(.) BETWEEN
C              COLUMNS ISTAR1 AND ISTOP1
C              FOR THE STRING DEFINED IN STRIN AND ISTRI2.
C     NOTE THAT THE STRING DEFINED IN ISTRIN AND ISTRI2
C     MAY BE EXPRESSED IN SEVERAL WAYS--
C          1) EXPLICITELY, E.G., LET    FOR    SUBSET, ETC.
C          2) IMPLICITELY WITH ! REPRESENTING THE FIRST
C             NON-BLANK CHARACTER THAT IS ENCOUNTERED;
C          3) IMPLICITELY WITH ; REPRESENTING ANY STRING
C             (INCLUDING ALL CHARACTERS, EVEN BLANKS));
C          4) IMPLICITELY WITH : REPRESENTING THE FIRST
C            BLANK CHARACTER THAT IS ENCOUNTERED.
C     NOTE--A GIVEN ARGUMENT MAY END UP WITH
C            3 DIFFERENT REPRESENTATIONS--
C            HOLLERITH, INTEGER, AND FLOATING POINT.
C     INPUT  ARGUMENTS--IANS   = A HOLLERITH 1-CHARACTER-PER-WORD
C                                VARIABLE CONTAINING THE INPUT LINE
C                                TO BE EXAMINED.
C                     --IWIDTH = THE (FULL) WIDTH OF THE INPUT LINE
C                                (THAT IS, THE NUMBER OF COLUMNS)
C                     --ISTAR1 = THE FIRST COLUMN FOR WHICH THE
C                                SCAN IS TO BE CARRIED OUT.
C                     --ISTOP1 = THE LAST  COLUMN FOR WHICH THE
C                                SCAN IS TO BE CARRIED OUT.
C                     --ISTRIN = THE HOLLERITH VARIABLE
C                                WHICH CONTAINS CHARACTERS 1 TO 4
C                                OF THE STRING TO BE SEARCHED FOR.
C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
C                                TO 4 CHARACTERS) OR IMPLICITELY
C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
C                                IS MORE GENERAL IN
C                                OTHER WAYS ALSO.
C                     --ISTRI2 = THE HOLLERITH VARIABLE
C                                WHICH CONTAINS CHARACTERS 5 TO 8
C                                OF THE STRING TO BE SEARCHED FOR.
C                                THE DEFINITION OF THE STRING IN ISTRIN MAY
C                                MAY BE DONE EXPLICTELY (BUT IS LIMITED
C                                TO 4 CHARACTERS) OR IMPLICITELY
C                                WHICH IS NOT LIMITED TO 4 CHARACTERS AND IS MOR
C                                IS MORE GENERAL IN
C                                OTHER WAYS ALSO.
C                     --INEX   = A HOLLERITH VARIABLE WHICH
C                                WILL CONTAIN ONE OF THE FOLLOWING 4 VALUES--
C                                II, IE, EI, EE THAT STANDS FOR
C                                WHERE I STANDS FOR INCLUSIVE AND
C                                WHERE E STANDS FOR EXCLUSIVE;
C                                INEX SPECIFIES WHETHER THE FIRST OR LAST CHARAC
C                                CHARACTER IS TO BE INCLUDED OR EXCLUDED IN
C                                IN DEFINING ISTAR2 AND ISTOP2.
C     OUTPUT ARGUMENTS--IFOUZ2 = A HOLLERITH VARIABLE
C                                WITH THE VALUE 'YES'
C                                IF THE STRING WAS FOUND;
C                                AND THE VALUE 'NO'
C                                IF THE STRING WAS NOT FOUND.
C                     --ISTAR2 = THE START COLUMN OF THE FOUND STRING
C                     --ISTOP2 = THE STOP COLUMN OF THE FIUND STRING.
C                     --ITYPE2 = A HOLLERITH VARIABLE
C                                WITH THE VALUE 'WORD' IF THE STRING CONTAINS
C                                ANY NON-NUMERIC (EXCLUDING BLANKS) CHARACTER;
C                                AND WITH THE VALUE 'NUMB' IF THE STRING CONTA
C                                ALL NUMERIC VALUES OR DECIMAL POINT OR + OR -
C                                (WITH INTERMITTENT BLANKS IGNORED).
C                     --IHOL   = THE HOLLERITH VARIABLE
C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
C                                OF CHARACTERS 1 TO 4 OF THE FOUND STRING.
C                     --IHOL2  = THE HOLLERITH VARIABLE
C                                CONTAINING THE PACKED (4 CHARACTERS) VERSION
C                                OF CHARACTERS 5 TO 8 OF THE FOUND STRING.
C                     --INT    = THE INTEGER VARIABLE
C                                CONTAINING THE INTEGER REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND STRING.
C                     --FLOAT  = THE FLOATING POINT VARIABLE
C                                CONTAINING THE FLOATING POINT REPRESENTATION
C                                (IF POSSIBLE) OF THE FOUND STRING.
C                     --IERROR = A HOLLERITH VARIABLE WITH VALUE
C                                'YES' OR 'NO' INDICATING IF AN
C                                ERROR CONDITION EXISTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 ISTRIN
      CHARACTER*4 ISTRI2
      CHARACTER*4 INEX
      CHARACTER*4 IBUGA3
      CHARACTER*4 IFOUZ2
      CHARACTER*4 ITYPE2
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ITEMP
      CHARACTER*4 IFLUNK
      CHARACTER*4 ISTRI3
      CHARACTER*4 ILAST
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
C
      DIMENSION ISTRI3(20)
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='DPTY'
      ISUBN2='P3  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTYP3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISTAR1,ISTOP1
   53 FORMAT('ISTAR1,ISTOP1 = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISTRIN,ISTRI2
   54 FORMAT('ISTRIN,ISTRI2 = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      NUMASC=4
C
C               ******************************************************
C               **  STEP 1--                                        **
C               **  INITIALIZE THE OUTPUT PARAMETERS AND VARIABLES  **
C               ******************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO150
      WRITE(ICOUT,101)
  101 FORMAT('AT THE BEGINNING OF DPTYP3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)IWIDTH
  102 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)(IANS(I),I=1,IWIDTH)
  103 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX
  104 FORMAT('ISTAR1,ISTOP1,ISTRIN,ISTRI2,INEX = ',I8,I8,A4,A4,A4)
      CALL DPWRST('XXX','BUG ')
  150 CONTINUE
      IFOUZ2='NO'
      ISTAR2=-1
      ISTOP2=-1
      ITYPE2='9999'
      IHOL ='9999'
      IHOL2='9999'
      INT = -999999
      FLOAT=-999999.0
C
C               ************************************************************
C               **  STEP 2--                                              **
C               **  DECOMPOSE THE INPUT SEARCH STRING INTO A1 CHARACTERS  **
C               ************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IMAX=2*NUMASC
      DO300I=1,IMAX
      I2=I
      J=I
      IF(I.GT.NUMASC)J=I-NUMASC
      ISTAR3=NUMBPC*(J-1)
      ISTAR3=IABS(ISTAR3)
      ITEMP='    '
      IF(I.LE.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRIN,0,NUMBPC,ITEMP)
      IF(I.GT.NUMASC)CALL DPCHEX(ISTAR3,NUMBPC,ISTRI2,0,NUMBPC,ITEMP)
      IF(ITEMP.EQ.'    ')GOTO350
      ISTRI3(I)=ITEMP
  300 CONTINUE
      ILEN2=I2
      GOTO390
  350 CONTINUE
      ILEN2=I2-1
  390 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO399
      WRITE(ICOUT,391)
  391 FORMAT('IN THE MIDDLE OF DPTYP3 (AFTER STEP 2)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,392)ILEN2
  392 FORMAT('ILEN2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,393)(ISTRI3(I),I=1,ILEN2)
  393 FORMAT('ISTRI3(.) = ',6A1)
      CALL DPWRST('XXX','BUG ')
  399 CONTINUE
C
C               ****************************************************************
C               **  STEP 3--
C               **  DISTINGUISH BETWEEN THE 3 TYPES OF POSSIBLE SEARCH STRINGS--
C               **  1) AN EXPLICITELY-DEFINED STRING; E.G.,
C               **     LET     FOR     SUBSET     =     5.3     -2.6666666
C               **     (AS IN COMMANDS, KEY WORDS, AND NUMBERS);
C               **  2) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
C               **     AND ENDING WITH SOME SPECIFIED CHARACTER; E.G., XXXXX(
C               **     (AS IN THE VARIABLE NAME OF A SUBSCRIPTED VARIABLE,
C               **     OR THE ARGUMENT (I. E., THE SUBSCRIPT) IN A SUBSCRIPTED
C               **     VARIABLE);
C               **  3) A STRING STARTING WITH THE FIRST NON-BLANK CHARACTER
C               **     AND ENDING WITH THE FIRST SUBSEQUENT BLANK CHARACTER
C               **     (OR ENDING WITH THE END OF THE LINE).
C               **     E.G., XXXX
C               **     (AS IN SOME UNSPECIFIED PARAMETER OR VARIABLE NAME).
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ICASE=1
      IF(ISTRI3(1).NE.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
     1ICASE=2
      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).NE.':')
     1ICASE=3
      IF(ISTRI3(1).EQ.'!'.AND.ISTRI3(2).EQ.';'.AND.ISTRI3(3).EQ.':')
     1ICASE=4
      IF(ILEN2.EQ.1.OR.ILEN2.EQ.2)ICASE=1
C
      IF(IBUGA3.EQ.'OFF')GOTO398
      WRITE(ICOUT,395)
  395 FORMAT('AFTER STEP 3 OF DPTYP3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,396)ICASE
  396 FORMAT('ICASE = ',I8)
      CALL DPWRST('XXX','BUG ')
  398 CONTINUE
C
C               *********************************************************
C               **  STEP 4--                                           **
C               **  DETERMINE IF THE DESIRED SEARCH STRING IS PRESENT  **
C               *********************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(ICASE.EQ.1)GOTO400
      IF(ICASE.EQ.2)GOTO500
      IF(ICASE.EQ.3)GOTO600
      IF(ICASE.EQ.4)GOTO700
C
  400 CONTINUE
      DO410I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(1))GOTO420
      GOTO410
  420 CONTINUE
      DO430J=1,ILEN2
      IPJM1=J+I-1
      IF(IPJM1.GT.ISTOP1)GOTO410
      IF(IANS(IPJM1).EQ.ISTRI3(J))GOTO430
      GOTO410
  430 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=I2
      IF(INEX.EQ.'IE')ISTAR2=I2
      IF(INEX.EQ.'EI')ISTAR2=I2+1
      IF(INEX.EQ.'EE')ISTAR2=I2+1
      IF(INEX.EQ.'II')ISTOP2=IPJM1
      IF(INEX.EQ.'IE')ISTOP2=IPJM1-1
      IF(INEX.EQ.'EI')ISTOP2=IPJM1
      IF(INEX.EQ.'EE')ISTOP2=IPJM1-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
  410 CONTINUE
      IFOUZ2='NO'
      GOTO9000
C
  500 CONTINUE
      DO510I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(1))GOTO520
  510 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  520 CONTINUE
      IMIN=I2
      DO530I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO540
  530 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  540 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II')ISTOP2=I2
      IF(INEX.EQ.'IE')ISTOP2=I2-1
      IF(INEX.EQ.'EI')ISTOP2=I2
      IF(INEX.EQ.'EE')ISTOP2=I2-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  600 CONTINUE
      DO610I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).NE.' ')GOTO620
  610 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  620 CONTINUE
      IMIN=I2
      DO630I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.ISTRI3(ILEN2))GOTO640
  630 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  640 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II')ISTOP2=I2
      IF(INEX.EQ.'IE')ISTOP2=I2-1
      IF(INEX.EQ.'EI')ISTOP2=I2
      IF(INEX.EQ.'EE')ISTOP2=I2-1
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  700 CONTINUE
      ILAST='BLAN'
      DO710I=ISTAR1,ISTOP1
      I2=I
      IF(IANS(I).NE.' ')GOTO720
  710 CONTINUE
      IFOUZ2='NO'
      GOTO9000
  720 CONTINUE
      IMIN=I2
      DO730I=IMIN,ISTOP1
      I2=I
      IF(IANS(I).EQ.' ')GOTO740
  730 CONTINUE
      ILAST='NOBL'
      IF(ISTOP1.EQ.IWIDTH)GOTO740
      IFOUZ2='NO'
      GOTO9000
  740 CONTINUE
      IFOUZ2='YES'
      IF(INEX.EQ.'II')ISTAR2=IMIN
      IF(INEX.EQ.'IE')ISTAR2=IMIN
      IF(INEX.EQ.'EI')ISTAR2=IMIN+1
      IF(INEX.EQ.'EE')ISTAR2=IMIN+1
      IF(INEX.EQ.'II'.AND.ISTOP1.NE.IWIDTH)
     1ISTOP2=I2
      IF(INEX.EQ.'II'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
     1ISTOP2=I2
      IF(INEX.EQ.'II'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
     1ISTOP2=I2
      IF(INEX.EQ.'IE'.AND.ISTOP1.NE.IWIDTH)
     1ISTOP2=I2-1
      IF(INEX.EQ.'IE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
     1ISTOP2=I2-1
      IF(INEX.EQ.'IE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
     1ISTOP2=I2
      IF(INEX.EQ.'EI'.AND.ISTOP1.NE.IWIDTH)
     1ISTOP2=I2
      IF(INEX.EQ.'EI'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
     1ISTOP2=I2
      IF(INEX.EQ.'EI'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
     1ISTOP2=I2
      IF(INEX.EQ.'EE'.AND.ISTOP1.NE.IWIDTH)
     1ISTOP2=I2-1
      IF(INEX.EQ.'EE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.EQ.'BLAN')
     1ISTOP2=I2-1
      IF(INEX.EQ.'EE'.AND.ISTOP1.EQ.IWIDTH.AND.ILAST.NE.'BLAN')
     1ISTOP2=I2
      IF(ISTAR2.LE.ISTOP2)GOTO990
      GOTO900
C
  900 CONTINUE
C
C     NOTE--THE FOLLOWING SECTION HAS BEEN 'BUGGED' OUT
C           TO CIRCUMVENT A PROBLEM WITH Y=(...
C           WHILE IT STILL LOOKED FOR A VARIABLE NAME
C           BETWEEN THE = AND THE (     .
C     CAUTION--WHEN IBUGA3 = 'OFF', AS IT USUALLY IS,
C              IERROR CAN NEVER BE 'YES'
C              UPON RETURN FROM DPTYP3:
C              BUT WHEN IBUGA3 = 'ON' (AS IN ERROR TRACING)
C              IERROR MAY = 'YES' WHICH MAY CHANGE THE
C              LOGIC PATH BACK IN DPTYP2.
C
      IF(IBUGA3.EQ.'OFF')GOTO9000
      WRITE(ICOUT,921)
  921 FORMAT('***** INTERNAL ERROR IN DPTYP3 SUBROUTINE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,922)
  922 FORMAT('ISTAR2 GREATER THAN ISTOP2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,923)ISTAR2,ISTOP2
  923 FORMAT('ISTAR2, ISTOP2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,924)ICASE
  924 FORMAT('ICASE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,925)IWIDTH
  925 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,926)(IANS(I),I=1,IWIDTH)
  926 FORMAT('IANS(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,927)ISTAR1,ISTOP1
  927 FORMAT('ISTAR1, ISTOP1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,928)ILEN2
  928 FORMAT('ILEN2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,929)(ISTRI3(I),I=1,ILEN2)
  929 FORMAT('ISTRI3(.) = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,930)ISTRIN,ISTRI2
  930 FORMAT('ISTRIN,ISTRI2 = ',2A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,931)INEX
  931 FORMAT('INEX = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  990 CONTINUE
C
C               ********************************************************
C               **  STEP 5--                                          **
C               **  CONVERT THE STRING INTO 2 HOLLERITH A4 WORDS.     **
C               **  IF MORE THAN 8 CHARACTERS, CONVERT ONLY           **
C               **  THE FIRST 8 CHARACTERS.                           **
C               **  OUTPUT THESE HOLLERITH WORDS AS IHOL AND IHOL2.   **
C               ********************************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IHOL ='    '
      IHOL2='    '
      IMAX=2*NUMASC
      J=0
      DO1000I=ISTAR2,ISTOP2
      J=J+1
      K=J
      IF(J.GT.NUMASC)K=J-NUMASC
      ISTAR3=NUMBPC*(K-1)
      ISTAR3=IABS(ISTAR3)
      IF(J.LE.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL)
      IF(J.GT.NUMASC)CALL DPCHEX(0,NUMBPC,IANS(I),ISTAR3,NUMBPC,IHOL2)
      IF(J.GE.IMAX)GOTO1050
 1000 CONTINUE
 1050 CONTINUE
C
C               ****************************************************************
C               **  STEP 6--
C               **  CONVERT (IF POSSIBLE) THE STRING INTO AN INTEGER ARGUMENT.
C               **  OUTPUT  THIS INTEGER VALUE IN INT.
C               ****************************************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IFLUNK='NO'
      ITYPE2='NUMB'
      IDIG=0
      ISIGN=0
      IDECPT=0
      ISUM=0
      DO2700I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO2700
      IF(IANS(IREV).EQ.'0')GOTO2710
      IF(IANS(IREV).EQ.'1')GOTO2711
      IF(IANS(IREV).EQ.'2')GOTO2712
      IF(IANS(IREV).EQ.'3')GOTO2713
      IF(IANS(IREV).EQ.'4')GOTO2714
      IF(IANS(IREV).EQ.'5')GOTO2715
      IF(IANS(IREV).EQ.'6')GOTO2716
      IF(IANS(IREV).EQ.'7')GOTO2717
      IF(IANS(IREV).EQ.'8')GOTO2718
      IF(IANS(IREV).EQ.'9')GOTO2719
      IF(IANS(IREV).EQ.'+')GOTO2720
      IF(IANS(IREV).EQ.'-')GOTO2721
      IF(IANS(IREV).EQ.'.')GOTO2722
      IFLUNK='YES'
      GOTO2800
 2710 ITERM=0
      GOTO2725
 2711 ITERM=1
      GOTO2725
 2712 ITERM=2
      GOTO2725
 2713 ITERM=3
      GOTO2725
 2714 ITERM=4
      GOTO2725
 2715 ITERM=5
      GOTO2725
 2716 ITERM=6
      GOTO2725
 2717 ITERM=7
      GOTO2725
 2718 ITERM=8
      GOTO2725
 2719 ITERM=9
      GOTO2725
 2720 ISIGN=ISIGN+1
      GOTO2700
 2721 ISIGN=ISIGN+1
      ISUM=-ISUM
      GOTO2700
 2722 IDECPT=IDECPT+1
      IF(IDECPT.EQ.1.AND.IDIG.EQ.0)GOTO2700
      GOTO2800
 2725 IDIG=IDIG+1
      TERM2=10.0**(IDIG-1)
      ITERM2=TERM2 + 0.01
      ISUM=ISUM+ITERM*ITERM2
 2700 CONTINUE
      IF(IDIG.LE.0)GOTO2800
      IF(ISIGN.GE.2)GOTO2800
      INT=ISUM
 2800 CONTINUE
      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
 2100 CONTINUE
 2999 CONTINUE
C
C               ********************************************************
C               **  STEP 7--                                          **
C               **  CONVERT (IF POSSIBLE) THE STRING INTO A FLOATING  **
C               **  POINT ARGUMENT.                                   **
C               **  OUTPUT THIS FLOATING POINT VALUE IN FLOAT.        **
C               ********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      AMIN=-1000000.
      AMAX=+1000000.
      IFLUNK='NO'
      ITYPE2='NUMB'
      FLOAT=-1.0
C
      ILOC=0
      IDECPT=0
      DO3060I=ISTAR2,ISTOP2
      IF(IANS(I).EQ.'.')ILOC=I
      IF(IANS(I).EQ.'.')IDECPT=IDECPT+1
 3060 CONTINUE
      IF(IDECPT.GE.2)GOTO3900
      IF(IDECPT.EQ.1)GOTO3150
      DO3100I=ISTAR2,ISTOP2
      IREV=ISTOP2-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO3100
      IF(IANS(IREV).EQ.'0')GOTO3110
      IF(IANS(IREV).EQ.'1')GOTO3110
      IF(IANS(IREV).EQ.'2')GOTO3110
      IF(IANS(IREV).EQ.'3')GOTO3110
      IF(IANS(IREV).EQ.'4')GOTO3110
      IF(IANS(IREV).EQ.'5')GOTO3110
      IF(IANS(IREV).EQ.'6')GOTO3110
      IF(IANS(IREV).EQ.'7')GOTO3110
      IF(IANS(IREV).EQ.'8')GOTO3110
      IF(IANS(IREV).EQ.'9')GOTO3110
      IFLUNK='YES'
      IF(IANS(IREV).EQ.'+')GOTO3900
      IF(IANS(IREV).EQ.'-')GOTO3900
      GOTO3900
 3100 CONTINUE
      IFLUNK='YES'
      GOTO3900
 3110 ILOC=IREV+1
 3150 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3111)ILOC,IDECPT
 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE
C
      SIGN=1.0
      IDIGI=0
      ISIGN=0
      SUMI=0
      ILOCM1=ILOC-1
      IF(ILOCM1.LT.ISTAR2)GOTO3250
      DO3200I=ISTAR2,ILOCM1
      IREV=ILOCM1-(I-ISTAR2)
      IF(IANS(IREV).EQ.' ')GOTO3200
      IF(IANS(IREV).EQ.'0')GOTO3210
      IF(IANS(IREV).EQ.'1')GOTO3211
      IF(IANS(IREV).EQ.'2')GOTO3232
      IF(IANS(IREV).EQ.'3')GOTO3213
      IF(IANS(IREV).EQ.'4')GOTO3214
      IF(IANS(IREV).EQ.'5')GOTO3215
      IF(IANS(IREV).EQ.'6')GOTO3216
      IF(IANS(IREV).EQ.'7')GOTO3217
      IF(IANS(IREV).EQ.'8')GOTO3218
      IF(IANS(IREV).EQ.'9')GOTO3219
      IF(IANS(IREV).EQ.'+')GOTO3220
      IF(IANS(IREV).EQ.'-')GOTO3221
      IFLUNK='YES'
      GOTO3900
 3210 ITERM=0
      GOTO3225
 3211 ITERM=1
      GOTO3225
 3232 ITERM=2
      GOTO3225
 3213 ITERM=3
      GOTO3225
 3214 ITERM=4
      GOTO3225
 3215 ITERM=5
      GOTO3225
 3216 ITERM=6
      GOTO3225
 3217 ITERM=7
      GOTO3225
 3218 ITERM=8
      GOTO3225
 3219 ITERM=9
      GOTO3225
 3220 ISIGN=ISIGN+1
      GOTO3200
 3221 ISIGN=ISIGN+1
      SIGN=-SIGN
      GOTO3200
 3225 IDIGI=IDIGI+1
      TERM=ITERM
      IEXP=IDIGI-1
      SUMI=SUMI+TERM*(10.0**IEXP)
 3200 CONTINUE
 3250 CONTINUE
      IF(ISIGN.GE.2)GOTO3900
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3255)IDIGI,SUMI
 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C     THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE
C
      IDIGD=0
      SUMD=0.0
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.ISTOP2)GOTO3350
      DO3300I=ILOCP1,ISTOP2
      IF(IANS(I).EQ.' ')GOTO3300
      IF(IANS(I).EQ.'0')GOTO3310
      IF(IANS(I).EQ.'1')GOTO3311
      IF(IANS(I).EQ.'2')GOTO3312
      IF(IANS(I).EQ.'3')GOTO3333
      IF(IANS(I).EQ.'4')GOTO3314
      IF(IANS(I).EQ.'5')GOTO3315
      IF(IANS(I).EQ.'6')GOTO3316
      IF(IANS(I).EQ.'7')GOTO3317
      IF(IANS(I).EQ.'8')GOTO3318
      IF(IANS(I).EQ.'9')GOTO3319
      IFLUNK='YES'
      GOTO3900
 3310 ITERM=0
      GOTO3325
 3311 ITERM=1
      GOTO3325
 3312 ITERM=2
      GOTO3325
 3333 ITERM=3
      GOTO3325
 3314 ITERM=4
      GOTO3325
 3315 ITERM=5
      GOTO3325
 3316 ITERM=6
      GOTO3325
 3317 ITERM=7
      GOTO3325
 3318 ITERM=8
      GOTO3325
 3319 ITERM=9
      GOTO3325
 3325 IDIGD=IDIGD+1
      TERM=ITERM
      SUMD=SUMD+TERM/(10.0**IDIGD)
 3300 CONTINUE
 3350 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3355)IDIGD,SUMD
 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IDIGT=IDIGI+IDIGD
      IF(IDIGT.LE.0)GOTO3900
      FLOAT=SUMI+SUMD
      IF(SIGN.LT.0.0)FLOAT=-FLOAT
      IF(AMIN.LE.FLOAT.AND.FLOAT.LE.AMAX)GOTO3000
      GOTO3900
C
 3900 CONTINUE
      IF(IFLUNK.EQ.'YES')ITYPE2='WORD'
 3000 CONTINUE
 3999 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9900
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9001)
 9001 FORMAT('****** AT THE END       OF DPTYP3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9002)IFOUZ2,ISTAR2,ISTOP2
 9002 FORMAT('IFOUZ2, ISTAR2, ISTOP2 = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9003)ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR
 9003 FORMAT('ITYPE2,IHOL,IHOL2,INT,FLOAT,IERROR = ',A4,2X,A4,A4,2X,
     1I8,F15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
 9900 CONTINUE
      RETURN
      END
      SUBROUTINE DPTYPE(IANSLC,IWIDTH,IBUGTY,
     1ICOM,ICOM2,ICOMT,ICOMI,ACOM,ICOMLC,ICOML2,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IHARG,IHARG2,IARGT,IARG,ARG,IHARLC,IHARL2,NUMARG,
     1IHOST1,IHOST2)
C
C     PUTPOSE--TAKE THE COMPONENTS OF AN INPUT COMMAND LINE
C              AND COMPUTE HOLLERITH, INTEGER, AND FLOATING POINT
C              EQUIVALENTS FOR EACH COMPONENT.
C     INPUT  ARGUMENTS--IANSLC   (A HOLLERITH VECTOR)
C                     --IWIDTH (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--ICOM   (AN A4 HOLLERITH VALUE FOR COMMAND)
C                     --ICOM2  (AN A4 HOLLERITH VALUE FOR COMMAND)
C                     --ICOMLC  (AN A4 HOLLERITH VALUE FOR COMMAND)
C                     --ICOML2  (AN A4 HOLLERITH VALUE FOR COMMAND)
C                     --IHARG  (AN A4 HOLLERITH VECTOR)
C                     --IHARG2 (AN A4 HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --ARG    (A FLOATING POINT VECTOR)
C                     --IHARLC (AN A4 HOLLERITH VECTOR)
C                     --IHARL2 (AN A4 HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C      NOTE--A GIVEN ARGUMENT MAY END UP WITH
C            3 DIFFERENT REPRESENTATIONS--
C            HOLLERITH, INTEGER, AND FLOATING POINT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 10, 1977.
C     UPDATED         --MAY       1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --SEPTEMBER 1986.
C     UPDATED         --FEBRUARY  1989.  ADJUST <> CASE (ALAN)
C     UPDATED         --AUGUST    1990.  FIX HONEYWELL/PRIME > PROBLEM
C     UPDATED         --OCTOBER   1997.  CHECK FOR EXPONENTIAL NUMBERS
C     UPDATED         --OCTOBER   2001.  BUG ON SUN
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IERROR
      CHARACTER*4 IANSLC
      CHARACTER*4 IBUGTY
      CHARACTER*4 ICOM
      CHARACTER*4 ICOM2
      CHARACTER*4 ICOMT
      CHARACTER*4 ICOMLC
      CHARACTER*4 ICOML2
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHARLC
      CHARACTER*4 IHARL2
      CHARACTER*4 IHOST1
      CHARACTER*4 IHOST2
C
      CHARACTER*4 IFLUNK
      CHARACTER*4 IB
      CHARACTER*4 IANS1
      CHARACTER*4 IANS2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*10 ICJUNK
      CHARACTER*5 IFRMT
C
C---------------------------------------------------------------------
C
      DIMENSION IANSLC(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
      DIMENSION IHARLC(*)
      DIMENSION IHARL2(*)
C
      DIMENSION ISTART(160)
      DIMENSION ISTOP(160)
      DIMENSION IB(160)
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='DPTY'
      ISUBN2='PE  '
      IERROR='OFF'
C
      IF(IBUGTY.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPTYPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IWIDTH
   52 FORMAT('IWIDTH = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(IANSLC(I),I=1,IWIDTH)
   53 FORMAT('(IANSLC(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IHOST1,IHOST2
   61 FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ************************************************************
C               **  DEFINE NUMASC = NUMBER OF ASCII CHARACTERS PER WORD.  **
C               **  THIS IS 4 REGARDLESS OF THE COMPUTER MAKE AND         **
C               **  REGARDLESS OF THE WORD SIZE.                          **
C               ************************************************************
C
      NUMASC=4
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOM='    '
      ICOM2='    '
      ICOMT='NUMB'
      ICOMI=(-1)
      ACOM=(-1.0)
      ICOMLC='    '
      ICOML2='    '
      DO110I=1,100
      IHARG(I)='    '
      IHARG2(I)='    '
      IARGT(I)='NUMB'
      IARG(I)=(-1)
      ARG(I)=(-1.0)
      IHARLC(I)='    '
      IHARL2(I)='    '
  110 CONTINUE
      NUMARG=(-1)
C
C               ****************************************************************
C               **  STEP 2--
C               **  SEPARATE IANSLC(.) INTO COMPONENTS WHERE
C               **  A COMPONENT IS DEFINED AS THAT SEPARATED BY 1 OR MORE BLANKS
C               **  IN ADDITION, AN EQUAL SIGN (=),
CCCCC --------------------------------------------------------------------
CCCCC THE FOLLOWING DEALING WITH > AND < WAS DEACTIVATED AUGUST 1990
CCCCC DUE TO FACT THAT > IS A DIRECTORY SEPARATOR FOR   AUGUST 1990
CCCCC CERTAIN COMPUTERS (E.G., HONEYWELL, PRIME).  AUGUST 1990
CCCCC AND     CALL DATAPLOT>DPSYSF.TEX    WAS BOMBING      AUGUST 1990
CCCCC WITH ARRAY OVERFLOW.                              AUGUST 1990
CCCCC THEREFORE--USER MUST MANUALLY MAKE SURE THAT > AND < AUGUST 1990
CCCCC            ARE SURROUNDED BY SPACES IN MATH COMMANDS.  AUGUST 1990
C               **  A GREATER-THAN SIGN (>), AND A LESS-THAN SIGN (<)
C               **  ARE ALSO CONSIDERED AS A COMPONENT UNTO ITSELF
C               **  REGARDLESS OF WHETHER OR NOT
C               **  IT HAS PRECEEDING AND SUCCEEDING BLANKS.
CCCCC --------------------------------------------------------------------
C               **  FINALLY, A HYPHEN WHEN IMMEDIATELY PRECEDED
C               **  AND SUCCEEDED BY A NON-BLANK CHARACTER
C               **  WILL ALSO BE CONSIDERED AS A SEPARATOR
C               **  AND SO WILL NOT BE COPIED AS A CHARACTER.
C               **  HOWEVER, IF THERE IS A BLANK BEFORE OR AFTER THE HYPHEN
C               **  (AS IN DEFINING THE    -    AS A PLOT CHARACTER TYPE),
C               **  THEN THE HYPHEN WILL BE TREATED AND COPIED AS A SEPARATE
C               **  COMPONENT.
C               **  OCTOBER 1997: CHECK FOR EXPONENTIAL NOTATION, I.E.
C               **      1.2E02, 1.2E-02, 1.2E+02, 1.2D02, 1.2D-02, 1.2D+02
C               **  TREAT THE CASE WHERE THE ORIGINAL LINE IANSLC(.) WAS NON-EMP
C               **  LOCATE THE START AND STOP COLUMNS FOR EACH 'WORD'.
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMWD=0
      DO300I=1,IWIDTH
      IM1=I-1
      IM2=I-2
      IP1=I+1
C
      IF(IANSLC(I).EQ.'=')GOTO350
      IF(IHOST1.EQ.'HONE')GOTO321
CCCCC IF(IANSLC(I).EQ.'>')GOTO350
CCCCC IF(IANSLC(I).EQ.'<')GOTO350
  321 CONTINUE
C  ADD "<>  " CASE
      IF(I.LE.1)GOTO346
      IF(IANSLC(I).EQ.'>'.AND.IANSLC(I-1).EQ.'<')GOTO300
  346 CONTINUE
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AUGUST 1990
CCCCC DUE TO BOMB ON HONEYWELL/PRIME WHEN TRYING TO EXECUTE  AUGUST 1990
CCCCC CALL DATAPLOT>DPSYSF.TEX   (> IS A DIRECTORY SYMBOL   AUGUST 1990
CCCCC ON HONEYWELL AND PRIME)               AUGUST 1990
CCCCC IF(IANSLC(I).EQ.'>')GOTO350
      IF(IANSLC(I).EQ.'<'.AND.IANSLC(I+1).EQ.'>')GOTO345
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AUGUST 1990
CCCCC TO PARALLEL THE COMMENTING OUT FOR    >   2 LINES ABOVE  AUGUST 1990
CCCCC IF(IANSLC(I).EQ.'<')GOTO350
C  END ADD
      IF(IANSLC(I).NE.' '.AND.I.LE.1)GOTO350
C
      IF(I.LE.1)GOTO360
      IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.' ')GOTO350
      IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'=')GOTO350
      IF(IHOST1.EQ.'HONE')GOTO331
CCCCC IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'>')GOTO350
CCCCC IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'<')GOTO350
  331 CONTINUE
C
      IF(I.LE.2)GOTO360
CCCCC OCTOBER 1997.  CHECK FOR EXPONENTIAL NOTATION,
CCCCC I.E., IF "-" IS PRECEDED BY AN "E" AND SUCCEDED BY A
CCCCC NUMBER.
      IF(IANSLC(IM1).EQ.'-')THEN
        IF(IANSLC(IM2).EQ.'E' .OR. IANSLC(IM2).EQ.'e')THEN
          CALL DPCOAN(IANSLC(I),IJUNK)
          IF(IJUNK.GE.48 .AND. IJUNK.LE.57)GOTO370
        ENDIF
      ENDIF
C
      IF(IANSLC(I).NE.' '.AND.IANSLC(IM1).EQ.'-')GOTO340
      GOTO360
C
  340 CONTINUE
      IF(IANSLC(IM2).EQ.'=')GOTO360
      IF(IANSLC(IM2).EQ.'-')GOTO355
      IF(IANSLC(IM2).NE.' ')GOTO350
      GOTO360
C
C  ADD "<>  " CASE
  345 CONTINUE
      NUMWD=NUMWD+1
      ISTART(NUMWD)=I
      ISTOP(NUMWD)=I+1
      GOTO390
C  END ADD
  350 CONTINUE
      NUMWD=NUMWD+1
C
  355 CONTINUE
      ISTART(NUMWD)=I
C
  360 CONTINUE
      IF(IANSLC(I).EQ.'=')GOTO370
CCCCC IF(IANSLC(I).EQ.'>')GOTO370
CCCCC IF(IANSLC(I).EQ.'<')GOTO370
      IF(IANSLC(I).NE.' '.AND.I.GE.IWIDTH)GOTO370
C
      IF(I.GE.IWIDTH)GOTO390
      IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.' ')GOTO370
      IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'=')GOTO370
CCCCC IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'>')GOTO370
CCCCC IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'<')GOTO370
      IF(IANSLC(I).NE.' '.AND.IANSLC(IP1).EQ.'-')GOTO370
C
      GOTO390
C
  370 CONTINUE
      ISTOP(NUMWD)=I
C
  390 CONTINUE
      IF(IBUGTY.EQ.'ON')
     1WRITE(ICOUT,391)NUMWD
  391 FORMAT('NUMWD = ',I8)
      IF(IBUGTY.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGTY.EQ.'ON'.AND.NUMWD.GE.1)
     1WRITE(ICOUT,392)I,NUMWD,ISTART(NUMWD),ISTOP(NUMWD)
  392 FORMAT('I,NUMWD,ISTART(NUMWD),ISTOP(NUMWD) = ',4I8)
      IF(IBUGTY.EQ.'ON'.AND.NUMWD.GE.1)
     1CALL DPWRST('XXX','BUG ')
  300 CONTINUE
      IF(NUMWD.LE.0)GOTO9000
C
C               ***********************************************************
C               **  STEP 3--                                             **
C               **  CONVERT THE FIRST STRING TO A COMMAND                **
C               **  EXTRACT THE FIRST 4 CHARACTERS OF                    **
C               **  THE COMMAND.  PACK THESE 4 CHARACTERS                **
C               **  INTO THE HOLLERITH VARIABLE ICOM.                    **
C               **  ONLY 4 CHARACTERS ARE RETAINED                       **
C               **  REGARDLESS OF THE MAX NUMBER OF                      **
C               **  CHARACTERS PER WORD ON A GIVEN                       **
C               **  COMPUTER (E.G., EVEN THOUGH UNIVAC                   **
C               **  COULD RETAIN 6 CHARACTERS PER WORD,                  **
C               **  IT IS SUFFICIENT              TO RETAIN              **
C               **  ONLY 4 CHARACTERS PER WORD--ON A UNIVAC              **
C               **  OR ANY OTHER COMPUTER.                               **
C               **  OR ANY OTHER COMPUTER.                               **
C               **  ALSO, IF THE NUMBER OF CHARACTERS                    **
C               **  IN THE FIRST WORD IS 5 OR MORE,                      **
C               **  THEN PACK CHARACTERS 5 THROUGH 8                     **
C               **  (OR CHARACTERS 5 THROUGH THE END OF THE WORD         **
C               **  IF THE END OF THE WORD IS BEFORE CHARACTER 8)        **
C               **  INTO THE 4-CHARACTER WORD ICOM2.                     **
C               ***********************************************************
C
      ISTEPN='3'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWORD=1
      IWID=ISTOP(IWORD)-ISTART(IWORD)+1
      JMIN=ISTART(IWORD)
      JMAX=ISTOP(IWORD)
      I=0
      DO800J=JMIN,JMAX
      I=I+1
      IB(I)=IANSLC(J)
  800 CONTINUE
C
      IANS1='    '
      IANS2='    '
      IMAX=2*NUMASC
      IF(IWID.LT.IMAX)IMAX=IWID
      IF(IBUGTY.EQ.'ON')WRITE(ICOUT,901)IMAX
  901 FORMAT('IMAX = ',I6)
      IF(IBUGTY.EQ.'ON')CALL DPWRST('XXX','BUG ')
      DO900I=1,IMAX
      IF(IB(I).EQ.' ')GOTO910
      IM4=I-4
      IF(I.LE.NUMASC)IANS1(I:I)=IB(I)
      IF(I.GT.NUMASC)IANS2(IM4:IM4)=IB(I)
  900 CONTINUE
  910 CONTINUE
      ICOMLC=IANS1
      ICOML2=IANS2
      CALL DPUPP4(ICOMLC,ICOM,IBUGTY,IERROR)
      CALL DPUPP4(ICOML2,ICOM2,IBUGTY,IERROR)
C
C               ********************************************
C               **  STEP 4--                              **
C               **  CONVERT STRINGS 2 THROUGH END         **
C               **  TO HOLLERITH A4 ARGUMENTS.            **
C               **  IF MORE THAN 8 CHARACTERS,            **
C               **  CONVERT ONLY THE FIRST 8 CHARACTERS   **
C               **  (REGARDLESS OF THE COMPUTER TYPE).    **
C               ********************************************
C
      ISTEPN='4'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMARG=NUMWD-1
      IF(NUMWD.LE.1)GOTO1999
      DO1000IWORD=2,NUMWD
      IWID=ISTOP(IWORD)-ISTART(IWORD)+1
C
      JMIN=ISTART(IWORD)
      JMAX=ISTOP(IWORD)
      I=0
      DO1100J=JMIN,JMAX
      I=I+1
      IB(I)=IANSLC(J)
 1100 CONTINUE
C
      IANS1='    '
      IANS2='    '
      IMAX=2*NUMASC
      IF(IWID.LT.IMAX)IMAX=IWID
      DO1200I=1,IMAX
      IF(IB(I).EQ.' ')GOTO1210
      IM4=I-4
      IF(I.LE.NUMASC)IANS1(I:I)=IB(I)
      IF(I.GT.NUMASC)IANS2(IM4:IM4)=IB(I)
 1200 CONTINUE
 1210 CONTINUE
      IWORM1=IWORD-1
      IHARLC(IWORM1)=IANS1
      IHARL2(IWORM1)=IANS2
C
 1000 CONTINUE
 1999 CONTINUE
C
C               **********************************************************
C               **  STEP 4.5--                                            **
C               **  CONVERT EACH ARGUMENT TO UPPER CASE.            **
C               **********************************************************
C
      ISTEPN='4.5'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1390
      DO1300I=1,NUMARG
      CALL DPUPP4(IHARLC(I),IHARG(I),IBUGTY,IERROR)
      CALL DPUPP4(IHARL2(I),IHARG2(I),IBUGTY,IERROR)
 1300 CONTINUE
 1390 CONTINUE
C
C               **********************************************************
C               **  STEP 5--                                            **
C               **  CONVERT STRINGS 1 THROUGH END TO INTEGER ARGUMENTS  **
C               **********************************************************
C
      ISTEPN='5'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMWD.LE.0)GOTO2999
      DO2000IWORD=1,NUMWD
      IWORM1=IWORD-1
C
      IF(IWORD.LE.1)GOTO2005
      GOTO2006
C
 2005 CONTINUE
      IH=ICOM
      IH2=ICOM2
      GOTO2009
C
 2006 CONTINUE
      IH=IHARG(IWORM1)
      IH2=IHARG2(IWORM1)
      GOTO2009
C
 2009 CONTINUE
      IF(NUMNAM.LE.0)GOTO2040
      DO2010INAME=1,NUMNAM
      IF(IH.EQ.IHNAME(INAME).AND.IH2.EQ.IHNAM2(INAME))GOTO2020
      GOTO2010
 2020 CONTINUE
      IF(IUSE(INAME).EQ.'P')GOTO2030
      GOTO2040
 2030 CONTINUE
      IF(IWORM1.GT.0)IARGT(IWORM1)='NUMB'
      IF(IWORM1.GT.0)IARG(IWORM1)=IVALUE(INAME)
      GOTO2000
 2010 CONTINUE
 2040 CONTINUE
C
      IFLUNK='NO'
      IANS3=(-1)
      IWID=ISTOP(IWORD)-ISTART(IWORD)+1
      JMIN=ISTART(IWORD)
      JMAX=ISTOP(IWORD)
      I=0
      DO2100J=JMIN,JMAX
      I=I+1
      IB(I)=IANSLC(J)
 2100 CONTINUE
C
      IDIG=0
      ISIGN=0
      IDECPT=0
      ISUM=0
      DO2700I=1,IWID
      IREV=IWID-I+1
      IF(IB(IREV).EQ.' ')GOTO2700
      IF(IB(IREV).EQ.'0')GOTO2710
      IF(IB(IREV).EQ.'1')GOTO2711
      IF(IB(IREV).EQ.'2')GOTO2712
      IF(IB(IREV).EQ.'3')GOTO2713
      IF(IB(IREV).EQ.'4')GOTO2714
      IF(IB(IREV).EQ.'5')GOTO2715
      IF(IB(IREV).EQ.'6')GOTO2716
      IF(IB(IREV).EQ.'7')GOTO2717
      IF(IB(IREV).EQ.'8')GOTO2718
      IF(IB(IREV).EQ.'9')GOTO2719
      IF(IB(IREV).EQ.'+')GOTO2720
      IF(IB(IREV).EQ.'-')GOTO2721
      IF(IB(IREV).EQ.'.')GOTO2722
      IFLUNK='YES'
      GOTO2800
 2710 ITERM=0
      GOTO2725
 2711 ITERM=1
      GOTO2725
 2712 ITERM=2
      GOTO2725
 2713 ITERM=3
      GOTO2725
 2714 ITERM=4
      GOTO2725
 2715 ITERM=5
      GOTO2725
 2716 ITERM=6
      GOTO2725
 2717 ITERM=7
      GOTO2725
 2718 ITERM=8
      GOTO2725
 2719 ITERM=9
      GOTO2725
 2720 ISIGN=ISIGN+1
      GOTO2700
 2721 ISIGN=ISIGN+1
      ISUM=-ISUM
      GOTO2700
 2722 IDECPT=IDECPT+1
      IF(IDECPT.EQ.1.AND.IDIG.EQ.0)GOTO2700
      GOTO2800
 2725 IDIG=IDIG+1
      IF(IDIG.EQ.1)THEN
        ISUM=ISUM+ITERM
      ELSE
CCCCC FOLLOWING FIXES WHAT APPEARS TO BE COMPILER BUG ON LAHEY 95
CCCCC COMPILER.  MAY 2001
CCCCC SPECIFICALLY, 10**IPOW SEEMS TO RETURN A 0.
CCCCC   ISUM=ISUM+ITERM*10**(IDIG-1)
        ITERM1=IDIG-1
        ITERM2=INT(10.0**ITERM1 + 0.01)
        ISUM=ISUM+ITERM*ITERM2
      ENDIF
 2700 CONTINUE
      IF(IDIG.LE.0)GOTO2800
      IF(ISIGN.GE.2)GOTO2800
      IANS3=ISUM
 2800 CONTINUE
      IWORM1=IWORD-1
      IF(IWORD.LE.1)ICOMI=IANS3
      IF(IWORD.GE.2)IARG(IWORM1)=IANS3
      IF(IWORD.LE.1.AND.IFLUNK.EQ.'YES')ICOMT='WORD'
      IF(IWORD.GE.2.AND.IFLUNK.EQ.'YES')IARGT(IWORM1)='WORD'
 2000 CONTINUE
 2999 CONTINUE
C
C               ***************************************************************
C               **  STEP 6--                                                 **
C               **  CONVERT STRINGS 2 THROUGH N TO FLOATING POINT ARGUMENTS  **
C               ***************************************************************
C
      ISTEPN='6'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ************************************************************
C               **  STEP 6.1--                                            **
C               **  FIRST OF ALL, LOCATE THE DECIMAL POINT (IF EXISTENT)  **
C               **  OCTOBER 1997.  CHECK FOR EXPONENTIAL NOTATION.   I.E. **
C               **  1.2E02, 1.2E-02, 1.2E+02                              **
C               ************************************************************
C
      ISTEPN='6.1'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC OCTOBER 1997.  FOR EXPONENTIAL NOTATION, NEED TO ALLOW LARGER NUMBERS
CCCCC AMIN=-1000000.
CCCCC AMAX=+1000000.
      AMIN=CPUMIN
      AMAX=CPUMAX
      NUMARG=NUMWD-1
CCCCC IF(NUMARG.LE.0)GOTO3999
      IF(NUMWD.LE.0)GOTO3999
      DO3000IWORD=1,NUMWD
C
      IWORM1=IWORD-1
C
      IF(IWORD.LE.1)GOTO3005
      GOTO3006
C
 3005 CONTINUE
      IH=ICOM
      IH2=ICOM2
      GOTO3009
C
 3006 CONTINUE
      IH=IHARG(IWORM1)
      IH2=IHARG2(IWORM1)
      GOTO3009
C
 3009 CONTINUE
C
      IF(NUMNAM.LE.0)GOTO3040
      DO3010INAME=1,NUMNAM
      IF(IH.EQ.IHNAME(INAME).AND.IH2.EQ.IHNAM2(INAME))GOTO3020
      GOTO3010
 3020 CONTINUE
      IF(IUSE(INAME).EQ.'P')GOTO3030
      GOTO3040
 3030 CONTINUE
      IF(IWORD.LE.1)ICOMT='NUMB'
      IF(IWORD.GE.2)IARGT(IWORM1)='NUMB'
      IF(IWORD.LE.1)ACOM=VALUE(INAME)
      IF(IWORD.GE.2)ARG(IWORM1)=VALUE(INAME)
      GOTO3000
 3010 CONTINUE
 3040 CONTINUE
C
      IFLUNK='NO'
      ANS2=(-1.0)
      IWID=ISTOP(IWORD)-ISTART(IWORD)+1
      JMIN=ISTART(IWORD)
      JMAX=ISTOP(IWORD)
      I=0
      DO3050J=JMIN,JMAX
      I=I+1
      IB(I)=IANSLC(J)
 3050 CONTINUE
C
      ILOC=0
      IDECPT=0
      ILOCE=0
      IEXPPT=0
      DO3060I=1,IWID
      IF(IB(I).EQ.'.')ILOC=I
      IF(IB(I).EQ.'.')IDECPT=IDECPT+1
      IF(IB(I).EQ.'E'.OR.IB(I).EQ.'e')ILOCE=I
      IF(IB(I).EQ.'E'.OR.IB(I).EQ.'e')IEXPPT=IEXPPT+1
 3060 CONTINUE
      IF(IDECPT.GE.2)GOTO3900
      IF(IEXPPT.GE.2)GOTO3900
C
      IESCAL=0
      IESIGN=1
      IWID2=IWID
      IF(ILOCE+1.GT.IWID)THEN
        IFLUNK='YES'
        GOTO3900
      ENDIF
      IF(IEXPPT.EQ.1)THEN
        IWID=ILOCE-1
        IF(IB(ILOCE+1).EQ.'-')THEN
          IESIGN=-1
          ISTRT2=ILOCE+2
        ELSEIF(IB(ILOCE+1).EQ.'+')THEN
          IESIGN=1
          ISTRT2=ILOCE+2
        ELSE
          IESIGN=1
          ISTRT2=ILOCE+1
        ENDIF
        ICOUNT=0
        ICJUNK='        '
        IF(ISTRT2.GT.IWID2)THEN
          IFLUNK='YES'
          GOTO3900
        ENDIF
        DO13065I=ISTRT2,IWID2
          IF(IB(I).EQ.' ')GOTO13065
          IF(IB(I).EQ.'0')GOTO13060
          IF(IB(I).EQ.'1')GOTO13060
          IF(IB(I).EQ.'2')GOTO13060
          IF(IB(I).EQ.'3')GOTO13060
          IF(IB(I).EQ.'4')GOTO13060
          IF(IB(I).EQ.'5')GOTO13060
          IF(IB(I).EQ.'6')GOTO13060
          IF(IB(I).EQ.'7')GOTO13060
          IF(IB(I).EQ.'8')GOTO13060
          IF(IB(I).EQ.'9')GOTO13060
          IFLUNK='YES'
          GOTO3900
13060     CONTINUE
          ICOUNT=ICOUNT+1
          ICJUNK(ICOUNT:ICOUNT)=IB(I)(1:1)
13065   CONTINUE
CCCCC   FOLLOWING TO ADDRESS BUG ON SUN.  OCTOBER 2001.
        IFRMT(1:5)='(I  )'
        IF(ICOUNT.LE.9)THEN
          WRITE(IFRMT(3:3),'(I1)')ICOUNT
        ELSE
          WRITE(IFRMT(3:4),'(I2)')ICOUNT
        ENDIF
        READ(ICJUNK(1:ICOUNT),IFRMT)IESCAL
      ENDIF
C
      IF(IDECPT.EQ.1)GOTO3150
      DO3100I=1,IWID
      IREV=IWID-I+1
      IF(IB(IREV).EQ.' ')GOTO3100
      IF(IB(IREV).EQ.'0')GOTO3110
      IF(IB(IREV).EQ.'1')GOTO3110
      IF(IB(IREV).EQ.'2')GOTO3110
      IF(IB(IREV).EQ.'3')GOTO3110
      IF(IB(IREV).EQ.'4')GOTO3110
      IF(IB(IREV).EQ.'5')GOTO3110
      IF(IB(IREV).EQ.'6')GOTO3110
      IF(IB(IREV).EQ.'7')GOTO3110
      IF(IB(IREV).EQ.'8')GOTO3110
      IF(IB(IREV).EQ.'9')GOTO3110
      IFLUNK='YES'
      IF(IB(IREV).EQ.'+')GOTO3900
      IF(IB(IREV).EQ.'-')GOTO3900
      GOTO3900
 3100 CONTINUE
      IFLUNK='YES'
      GOTO3900
 3110 ILOC=IREV+1
 3150 CONTINUE
      IF(IBUGTY.NE.'OFF')WRITE(ICOUT,3111)ILOC,IDECPT
 3111 FORMAT('ILOC = ',I8,'    IDECPT = ',I8)
      IF(IBUGTY.NE.'OFF')CALL DPWRST('XXX','BUG ')
C
C               *******************************************************
C               **  STEP 6.2--                                       **
C               **  SECONDLY, COMPUTE THE INTEGER PART OF THE VALUE  **
C               *******************************************************
C
      ISTEPN='6.2'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SIGN=1.0
      IDIGI=0
      ISIGN=0
      SUMI=0
      ILOCM1=ILOC-1
      IF(ILOCM1.LT.1)GOTO3250
      DO3200I=1,ILOCM1
      IREV=ILOCM1-I+1
      IF(IB(IREV).EQ.' ')GOTO3200
      IF(IB(IREV).EQ.'0')GOTO3210
      IF(IB(IREV).EQ.'1')GOTO3211
      IF(IB(IREV).EQ.'2')GOTO3232
      IF(IB(IREV).EQ.'3')GOTO3213
      IF(IB(IREV).EQ.'4')GOTO3214
      IF(IB(IREV).EQ.'5')GOTO3215
      IF(IB(IREV).EQ.'6')GOTO3216
      IF(IB(IREV).EQ.'7')GOTO3217
      IF(IB(IREV).EQ.'8')GOTO3218
      IF(IB(IREV).EQ.'9')GOTO3219
      IF(IB(IREV).EQ.'+')GOTO3220
      IF(IB(IREV).EQ.'-')GOTO3221
      IFLUNK='YES'
      GOTO3900
 3210 ITERM=0
      GOTO3225
 3211 ITERM=1
      GOTO3225
 3232 ITERM=2
      GOTO3225
 3213 ITERM=3
      GOTO3225
 3214 ITERM=4
      GOTO3225
 3215 ITERM=5
      GOTO3225
 3216 ITERM=6
      GOTO3225
 3217 ITERM=7
      GOTO3225
 3218 ITERM=8
      GOTO3225
 3219 ITERM=9
      GOTO3225
 3220 ISIGN=ISIGN+1
      GOTO3200
 3221 ISIGN=ISIGN+1
      SIGN=-SIGN
      GOTO3200
 3225 IDIGI=IDIGI+1
      TERM=ITERM
      IEXP=IDIGI-1
      SUMI=SUMI+TERM*(10.0          **IEXP)
 3200 CONTINUE
 3250 CONTINUE
      IF(ISIGN.GE.2)GOTO3900
      IF(IBUGTY.NE.'OFF')WRITE(ICOUT,3255)IDIGI,SUMI
 3255 FORMAT('IDIGI = ',I8,'    SUMI = ',F20.10)
      IF(IBUGTY.NE.'OFF')CALL DPWRST('XXX','BUG ')
C
C               ******************************************************
C               **  STEP 6.3--                                      **
C               **  THIRDLY, COMPUTE THE DECIMAL PART OF THE VALUE  **
C               ******************************************************
C
      ISTEPN='6.3'
      IF(IBUGTY.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDIGD=0
      SUMD=0.0
      ILOCP1=ILOC+1
      IF(ILOCP1.GT.IWID)GOTO3350
      DO3300I=ILOCP1,IWID
      IF(IB(I).EQ.' ')GOTO3300
      IF(IB(I).EQ.'0')GOTO3310
      IF(IB(I).EQ.'1')GOTO3311
      IF(IB(I).EQ.'2')GOTO3312
      IF(IB(I).EQ.'3')GOTO3333
      IF(IB(I).EQ.'4')GOTO3314
      IF(IB(I).EQ.'5')GOTO3315
      IF(IB(I).EQ.'6')GOTO3316
      IF(IB(I).EQ.'7')GOTO3317
      IF(IB(I).EQ.'8')GOTO3318
      IF(IB(I).EQ.'9')GOTO3319
      IFLUNK='YES'
      GOTO3900
 3310 ITERM=0
      GOTO3325
 3311 ITERM=1
      GOTO3325
 3312 ITERM=2
      GOTO3325
 3333 ITERM=3
      GOTO3325
 3314 ITERM=4
      GOTO3325
 3315 ITERM=5
      GOTO3325
 3316 ITERM=6
      GOTO3325
 3317 ITERM=7
      GOTO3325
 3318 ITERM=8
      GOTO3325
 3319 ITERM=9
      GOTO3325
 3325 IDIGD=IDIGD+1
      TERM=ITERM
      SUMD=SUMD+TERM/(10.0          **IDIGD)
 3300 CONTINUE
 3350 CONTINUE
      IF(IBUGTY.NE.'OFF')WRITE(ICOUT,3355)IDIGD,SUMD
 3355 FORMAT('IDIGD = ',I8,'    SUMD = ',F20.10)
      IF(IBUGTY.NE.'OFF')CALL DPWRST('XXX','BUG ')
      IDIGT=IDIGI+IDIGD
      IF(IDIGT.LE.0)GOTO3900
      ANS2=SUMI+SUMD
      IF(SIGN.LT.0.0)ANS2=-ANS2
      ANS2=ANS2*10.0**(IESIGN*IESCAL)
      IWORM1=IWORD-1
      IF(IWORD.LE.1)ACOM=ANS2
      IF(IWORD.GE.2)ARG(IWORM1)=ANS2
CCCC OCTOBER 1997.  IF EXPONENTIAL NUMBER, NEED TO RESET IARGT
      IF(AMIN.LE.ANS2.AND.ANS2.LE.AMAX)THEN
        IF(IWORM1.GE.1)IARGT(IWORM1)='NUMB'
        GOTO3000
      ELSE
        GOTO3900
      ENDIF
C
 3900 CONTINUE
      IF(IWORM1.LT.1) GOTO 3000
      IWORM1=IWORD-1
      ARG(IWORM1)=ANS2
      IF(IFLUNK.EQ.'YES')IARGT(IWORM1)='WORD'
 3000 CONTINUE
 3999 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGTY.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPTYPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICOM,ICOM2,ICOMT,ACOM,ICOMI
 9012 FORMAT('ICOM,ICOM2,ICOMT,ACOM,ICOMI = ',
     1A4,2X,A4,2X,A4,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICOMLC,ICOML2
 9013 FORMAT('ICOMLC,ICOML2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMARG
 9014 FORMAT('NUMARG = ',I6)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMARG
      WRITE(ICOUT,9016)I,IHARG(I),IHARG2(I),IARG(I),ARG(I),IARGT(I)
 9016 FORMAT('I,IHARG(I),IHARG2(I),IARG(I),ARG(I),IARGT(I) = ',
     1I6,1X,A4,1X,A4,1X,I6,1X,E15.7,1X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)I,IHARLC(I),IHARL2(I)
 9017 FORMAT('I,IHARLC(I),IHARL2(I) = ',I6,1X,A4,1X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IHOST1,IHOST2
 9021 FORMAT('IHOST1,IHOST2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
