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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --MAY 1982. C 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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--89/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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--SEPTEMBER 1980. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88/2 C ORIGINAL VERSION--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--88/2 C ORIGINAL VERSION--FEBRUARY 1988. C UPDATED --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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2899 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 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 INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2003/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 INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-975-2855 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--2003/2 C ORIGINAL VERSION--FEBRUARY 2003. C UPDATED --OCTOBER 2003. ADD SUPPORT FOR HTML, LATEX C OUTPUT C C UPDATED --OCTOBER 2006. CALL LIST TO TPPF 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,REAL(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('') 5004 FORMAT('

') WRITE(ICOUT,5001) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,5004) CALL DPWRST('XXX','WRIT') WRITE(ICOUT,999) CALL DPWRST('XXX','WRIT') C C STEP 2: START TABLE AND DEFINE A CAPTION C 5011 FORMAT('') 5099 FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2B: START TABLE AND DEFINE A CAPTION
C
        WRITE(ICOUT,5004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3B: DEFINE HEADER ROW
C
 5121   FORMAT('   ')
 5123   FORMAT('      ')
 5127   FORMAT('      ')
 5139   FORMAT('   ')
 5131   FORMAT('         Confidence
Value (%)')
 5132   FORMAT('         t
Value')
 5133   FORMAT('         t X Standard Error)')
 5134   FORMAT('         Lower
Limit')
 5135   FORMAT('         Upper
Limit')
 5161   FORMAT('      ')
 5162   FORMAT('          
')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5131)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5132)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5133)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5134)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5135)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5039)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5141   FORMAT('   ')
 5143   FORMAT('      ')
 5147   FORMAT('      ')
 5151   FORMAT('         ',F8.3)
 5152   FORMAT('         ',G12.6)
 5149   FORMAT('   ')
        DO5180I=1,8
          WRITE(ICOUT,5141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)CONF(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5151)T(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)TSDM(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)ALOWER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5152)AUPPER(I)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5149)
          CALL DPWRST('XXX','WRIT')
 5180   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('')
 5193   FORMAT('')
 5199   FORMAT('
')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5199)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf Confidence Limits for the 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION 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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 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,
     1ICAPSW,ISUBRO,
     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     EXAMPLES--LET TEND = ; RELIABILITY TREND TEST Y
C             --LET TEND = ; RELIABILITY TREND TEST Y GROUPID
C             --RELIABILITY TREND TEST Y GROUPID CENSOR
C     REFERENCE--TOBIAS AND TRINDADE (1995), "APPLIED RELIABILITY
C                ANALYSIS", SECOND EDITION, CHAPMAN & HALL/CRC,
C                PP. 344-354.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --OCTOBER   2006. SUPPORT FOR MULTIPLE SYSTEMS
C     UPDATED         --OCTOBER   2006. CAPTURE HTML/LATEX/RTF
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ISUBRO
      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
      CHARACTER*4 IHGROU
      CHARACTER*4 IHGRO2
      CHARACTER*4 IHCENS
      CHARACTER*4 IHCEN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XCEN(MAXOBV)
      DIMENSION TEMP1(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      DIMENSION TEMP3(MAXOBV)
      DIMENSION TEMP4(MAXOBV)
      DIMENSION TEMP5(MAXOBV)
      DIMENSION TEMP6(MAXOBV)
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(1))
      EQUIVALENCE (GARBAG(IGARB3),XCEN(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP1(1))
      EQUIVALENCE (GARBAG(IGARB5),TEMP2(1))
      EQUIVALENCE (GARBAG(IGARB6),TEMP3(1))
      EQUIVALENCE (GARBAG(IGARB7),TEMP4(1))
      EQUIVALENCE (GARBAG(IGARB8),TEMP5(1))
      EQUIVALENCE (GARBAG(IGARB9),TEMP6(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='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=3
      MINN2=4
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               **********************************
C               **  TREAT THE TRENDS TEST CASE  **
C               **********************************
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
        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,IBUGQ
   52   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)MAXNXT
   55   FORMAT('MAXNXT = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     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')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ******************************************************
C               **  STEP 4--                                        **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS 2 OR MORE. **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,311)
  311   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,312)
  312   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,314)
  314   FORMAT('      RELIABILITY TRENDS TEST WAS TO HAVE BEEN ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,315)MINN2
  315   FORMAT('      CARRIED OUT 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)THEN
          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
  318     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
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='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        TEND=CPUMIN
      ELSE
        TEND=VALUE(ILOCP)
      ENDIF
C
C               ********************************************
C               **  STEP 13--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  (THIS WILL BE THE GROUP-ID VARIABLE)  **
C               ********************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHGROU=IHARG(2)
      IHGRO2=IHARG2(2)
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IHGROU,IHGRO2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')THEN
        ICOLG=0
        NGROUP=0
      ELSE
        ICOLG=IVALUE(ILOCV)
        NGROUP=IN(ILOCV)
      ENDIF
C
C               ****************************************************
C               **  STEP 14--                                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS   **
C               **  (NGROUP) FOR THE GROUP-ID VARIABLE IS EQUAL   **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE   **
C               **  VARIABLE.                                     **
C               ****************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NGROUP.GT.0 .AND. (NGROUP.NE.NLEFT))THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1412)IHGROU,IHGRO2
 1412   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN THE GROUP-ID VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      IS NOT EQUAL TO THE NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1414)IHLEFT,IHLEF2
 1414   FORMAT('      IN THE RESPONSE VARIABLE ',A4,A4,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1415)IHGROU,IHGROU2,NGROUP
 1415   FORMAT('      THE NUMBBER OF OBSERVATIONS IN ',A4,A4,
     1         ' = ',I10)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1415)IHLEFT,IHLEF2,NLEFT
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1417)
 1417   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1418)(IANS(I),I=1,MAX(80,IWIDTH))
 1418     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 15--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 3      **
C               **  (THIS WILL BE THE CESNORING VARIABLE) **
C               ********************************************
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHCENS=IHARG(3)
      IHCEN2=IHARG2(3)
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IHCENS,IHCEN2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')THEN
        ICOLC=0
        NCENS=0
      ELSE
        ICOLC=IVALUE(ILOCV)
        NCENS=IN(ILOCV)
      ENDIF
C
C               ****************************************************
C               **  STEP 16--                                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS   **
C               **  (NCENS) FOR THE CENSORING VARIABLE IS EQUAL   **
C               **  THE NUMBER OF OBSERVATIONS FOR THE RESPONSE   **
C               **  VARIABLE.                                     **
C               ****************************************************
C
      ISTEPN='16'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NCENS.GT.0 .AND. (NCENS.NE.NLEFT))THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1611)
 1611   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1612)IHCENS,IHCEN2
 1612   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN THE CENSORING VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1613)
 1613   FORMAT('      IS NOT EQUAL TO THE NUMBER OF OBSERVATIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1614)IHLEFP,IHLEF2
 1614   FORMAT('      IN THE RESPONSE VARIABLE ',A4,A4,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1615)IHCENS,IHCEN2,NCENS
 1615   FORMAT('      THE NUMBBER OF OBSERVATIONS IN ',A4,A4,
     1         ' = ',I10)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1615)IHLEFP,IHLEF2,NLEFT
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1617)
 1617   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1618)(IANS(I),I=1,MAX(80,IWIDTH))
 1618     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
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
C
      IF(ILOCQ.EQ.2)THEN
        NCENS=0
        NGROUP=0
      ENDIF
      IF(ILOCQ.EQ.3)THEN
        NCENS=0
      ENDIF
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')THEN
        WRITE(ICOUT,491)NUMARG,ILOCQ,NCENS,NGROUP
  491   FORMAT('NUMARG,ILOCQ,NRESP,NGROUP = ',4I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER OF VARIABLES    **
C               **  (EITHER 1, 2, OR 3)                      **
C               **  FOR A RELIABILITY TRENDS PLOT            **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.LT.1 .OR. NUMV2.GT.MAXV2)THEN
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2251)
 2251   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2253)
 2253   FORMAT('      THE NUMBER OF VARIABLES MUST BE 1, 2, OR 3;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2255)
 2255   FORMAT('      SUCH WAS NOT THE CASE HERE;  THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2257)NUMV2
 2257   FORMAT('      NUMBER OF VARIABLES WAS ',I10)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2258)
 2258   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2259)(IANS(I),I=1,MAX(80,IWIDTH))
 2259     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
C
      ENDIF
C
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.'TREN')
     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,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
C
      IF(NQ.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,551)
  551   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        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('      FOR WHICH A TRENDS TEST 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)THEN
          WRITE(ICOUT,559)(IANS(I),I=1,MIN(80,IWIDTH))
  559     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
C
      DO570I=1,IMAX
C
        IF(ISUB(I).EQ.0)GOTO570
        J=J+1
        IJ=MAXN*(ICOLL-1)+I
        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
        IF(NGROUP.GT.0)THEN
          IJ=MAXN*(ICOLG-1)+I
          IF(ICOLG.LE.MAXCOL)X1(J)=V(IJ)
          IF(ICOLG.EQ.MAXCP1)X1(J)=PRED(I)
          IF(ICOLG.EQ.MAXCP2)X1(J)=RES(I)
          IF(ICOLG.EQ.MAXCP3)X1(J)=YPLOT(I)
          IF(ICOLG.EQ.MAXCP4)X1(J)=XPLOT(I)
          IF(ICOLG.EQ.MAXCP5)X1(J)=X2PLOT(I)
          IF(ICOLG.EQ.MAXCP6)X1(J)=TAGPLO(I)
        ELSE
          X1(J)=0.0
        ENDIF
C
        IF(NCENS.GT.0)THEN
          IJ=MAXN*(ICOLC-1)+I
          IF(ICOLC.LE.MAXCOL)XCEN(J)=V(IJ)
          IF(ICOLC.EQ.MAXCP1)XCEN(J)=PRED(I)
          IF(ICOLC.EQ.MAXCP2)XCEN(J)=RES(I)
          IF(ICOLC.EQ.MAXCP3)XCEN(J)=YPLOT(I)
          IF(ICOLC.EQ.MAXCP4)XCEN(J)=XPLOT(I)
          IF(ICOLC.EQ.MAXCP5)XCEN(J)=X2PLOT(I)
          IF(ICOLC.EQ.MAXCP6)XCEN(J)=TAGPLO(I)
        ELSE
          XCEN(J)=0.0
        ENDIF
C
  570 CONTINUE
      NS=J
C
C               ******************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPTREN2--
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'TREN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
        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,Y1(I)
 1216     FORMAT('I,Y1(I) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
 1215   CONTINUE
        WRITE(ICOUT,1231)IBUGA3
 1231   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      CALL DPTRE2(Y1,NS,X1,NGROUP,XCEN,NCENS,
     1            ICAPSW,ICAPTY,
     1            XTEMP1,XTEMP2,
     1            TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
     1            TEND,MAXNXT,
     1            ISUBRO,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'TREN')THEN
        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 ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPTRE2(Y,N,X1,NGROUP,XCEN,NCENS,
     1            ICAPSW,ICAPTY,
     1            XTEMP1,XTEMP2,
     1            XIDTEM,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,
     1            TEND,MAXNXT,
     1            ISUBRO,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 OF
C                               (UNSORTED) REPAIR/CENSORING TIMES.
C                    --X1     = THE OPTIONAL SINGLE PRECISION VECTOR
C                               GROUP-ID VALUES
C                    --XCEN   = THE OPTIONAL SINGLE PRECISION VECTOR
C                               OF CENSOR VALUES (1 = REPAIR
C                               TIME, 0 = CENSOR TIME).
C                      NY     = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR Y.
C                      NX     = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X1.
C                      NC     = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR XCEN.
C     REFERENCE--TOBIAS AND TRINDADE (1995), "APPLIED
C                RELIABILITY", SECOND EDITION, CHAPMAN AND HALL,
C                PP. 314.
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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/5
C     ORIGINAL VERSION--MAY       1998.
C     UPDATED         --OCTOBER   2006. SUPPORT FOR MULTIPLE SYSTEMS
C     UPDATED         --OCTOBER   2006. SUPPORT FOR HTML/LATEX/RFT
C                                       OUTPUT
C     UPDATED         --OCTOBER   2006. CHANGE OUTPUT FORMAT FOR
C                                       REVERSE ARRANGEMENT TEST
C                                       AND CORRECTED BUG IN THIS
C                                       TEST
C     UPDATED         --OCTOBER   2006. CODE FOR SINGLE TEST
C                                       EXTRACTED TO DPTRE3
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION DSUM3
      DOUBLE PRECISION DVAL2
      DOUBLE PRECISION DVAL3
C
      REAL MHTPVA
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DSUM
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*6 ICONC4
      CHARACTER*6 ICONC5
      CHARACTER*6 ICONC6
C
      DIMENSION Y(*)
      DIMENSION X1(*)
      DIMENSION XCEN(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XIDTEM(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION TEMP4(*)
      DIMENSION TEMP5(*)
      DIMENSION TEMP6(*)
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*50 IVALUE(MAXHED)
      CHARACTER*50 IVAL2
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*1 IBASLC
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      INCLUDE 'DPCOST.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPTR'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      MAXSYS=10000
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE2')THEN
        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,MIN(N,100)
          WRITE(ICOUT,57)I,Y(I),X1(I),XCEN(I)
   57     FORMAT('I,Y(I),X1(I),XCEN(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR IN RELIABILITY TREND TEST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)
  112   FORMAT('      THE NUMBER OF OBSERVATIONS IN THE RESPONSE ',
     1        'VARIABLE IS NON-POSITIVE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,115)N
  115   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
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,111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.7)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  139 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  GENERATE THE RELIABILITY TREND TESTS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     CASE 1: NO GROUP OR CENSORING VARIABLE
C
      IF(NGROUP.EQ.0 .AND. NCENS.EQ.0)THEN
        ISET=1
        CALL DPTRE3(Y,N,XTEMP1,XTEMP2,TEND,MAXNXT,
     1              RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
     1              ISET,ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        NUMSET=1
C
C       CASE 2: GROUP VARIABLE, BUT NO CENSORING VARIABLE
C
      ELSEIF(NCENS.EQ.0)THEN
C
C       STEP 1: DETERMINE UNIQUE GROUPS
C
        NUMSET=0
        DO1051I=1,N
          IF(NUMSET.EQ.0)GOTO1053
          DO1052J=1,NUMSET
            IF(X1(I).EQ.XIDTEM(J))GOTO1051
 1052     CONTINUE
 1053     CONTINUE
          NUMSET=NUMSET+1
          XIDTEM(NUMSET)=X1(I)
 1051   CONTINUE
        CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
C       STEP 2: GENERATE TRACES FOR EACH GROUP
C
        J=0
        DO1090ISET=1,NUMSET
C
          K=0
          DO1091I=1,N
            IF(X1(I).EQ.XIDTEM(ISET))THEN
              K=K+1
              TEMP2(K)=Y(I)
            ENDIF
1091      CONTINUE
          NI=K
          CALL DPTRE3(TEMP2,NI,XTEMP1,XTEMP2,TEND,MAXNXT,
     1                RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
     1                ISET,ICAPSW,ICAPTY,
     1                ISUBRO,IBUGA3,IERROR)
          TEMP6(ISET)=RATPVA
          TEMP6(MAXSYS+ISET)=MHTPVA
          TEMP6(2*MAXSYS+ISET)=REAL(DSUM1)
          TEMP6(3*MAXSYS+ISET)=REAL(DVAL2)
          TEMP6(4*MAXSYS+ISET)=REAL(DVAL3)
1090    CONTINUE
C
C       CASE 3: BOTH GROUP VARIABLE AND CENSORING VARIABLE
C
      ELSE
C
C       STEP 1: DETERMINE UNIQUE GROUPS
C
        NUMSET=0
        DO1111I=1,N
          IF(NUMSET.EQ.0)GOTO1113
          DO1112J=1,NUMSET
            IF(X1(I).EQ.XIDTEM(J))GOTO1111
 1112     CONTINUE
 1113     CONTINUE
          NUMSET=NUMSET+1
          XIDTEM(NUMSET)=X1(I)
 1111   CONTINUE
        CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
C       STEP 2A: EXTRACT RESPONSE AND CENSORING DATA FOR EACH
C                GROUP
C
        J=0
        ISETMX=NUMSET
        DO1120ISET=1,NUMSET
C
          K=0
          DO1121I=1,N
            IF(X1(I).EQ.XIDTEM(ISET))THEN
              K=K+1
              TEMP2(K)=Y(I)
              TEMP3(K)=XCEN(I)
            ENDIF
1121      CONTINUE
          NI=K
C
C       STEP 2B: PROCESS THE CENSORING VARIABLE.  THERE CAN
C                BE AT MOST ONE CENSORING POINT FOR EACH
C                GROUP.
C
          CALL SORTC(TEMP2,TEMP3,NI,TEMP4,TEMP5)
          DO1160I=1,NI
            TEMP2(I)=TEMP4(I)
            TEMP3(I)=TEMP5(I)
 1160     CONTINUE
          AREP=TEMP3(1)
          ACEN=TEMP2(NI)
          IF(NI.LE.1)THEN
            NTEMPR=1
            NTEMPC=0
          ELSE
            IF(AREP.EQ.ACEN)THEN
              NTEMPR=NI
              NTEMPC=0
              DO1170I=1,NI
                IF(TEMP3(I).NE.AREP)THEN
                  WRITE(ICOUT,999)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,111)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1171)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1172)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1173)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1174)XIDTEM(ISET)
                  CALL DPWRST('XXX','BUG ')
                  IERROR='YES'
                  GOTO1120
                ENDIF
 1170         CONTINUE
            ELSE
              TEND=TEMP2(NI)
              NTEMPR=NI-1
              NTEMPC=1
              DO1180I=1,NTEMPR
                IF(TEMP3(I).NE.AREP)THEN
                  WRITE(ICOUT,999)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,111)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1171)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1172)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1173)
                  CALL DPWRST('XXX','BUG ')
                  WRITE(ICOUT,1174)XIDTEM(ISET)
                  CALL DPWRST('XXX','BUG ')
                  IERROR='YES'
                  GOTO1120
                ENDIF
 1180         CONTINUE
            ENDIF
          ENDIF
 1171 FORMAT('      FOR EACH SYSTEM, THERE SHOULD BE AT MOST')
 1172 FORMAT('      ONE CENSORING TIME AND IT MUST BE THE MAXIMUM')
 1173 FORMAT('      VALUE FOR THAT SYSTEM.')
 1174 FORMAT('      SUCH WAS NOT THE CASE FOR SYSTEM ',G15.7)
C
C       STEP 2C: COMPUTE THE TREND TEST FOR A SINGLE SYSTEM
C
          TEND=ACEN
          CALL DPTRE3(TEMP2,NTEMPR,XTEMP1,XTEMP2,TEND,MAXNXT,
     1                RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
     1                ISET,ICAPSW,ICAPTY,
     1                ISUBRO,IBUGA3,IERROR)
          TEMP6(ISET)=RATPVA
          TEMP6(MAXSYS+ISET)=MHTPVA
          TEMP6(2*MAXSYS+ISET)=REAL(DSUM1)
          TEMP6(3*MAXSYS+ISET)=REAL(DVAL2)
          TEMP6(4*MAXSYS+ISET)=REAL(DVAL3)
C
1120    CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  PERFORM COMPOSITE TESTS               **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMSET.LE.1)GOTO9000
C
C     COMPOSITE TESTS
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
        ITTEMP='Reverse Arrangements Test: Fisher Composite Test'
        NCTEMP=48
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5020I=1,5
          ALIGN(I)='CENTER'
          NUMDI2(I)=0
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5020   CONTINUE
        NUMDI2(2)=-2
        NUMDI2(3)=-2
C
        IVALUE(1)='System'
        NCHAR(1)=6
        IVALUE(2)='P-Value'
        NCHAR(2)=7
        IVALUE(3)='-2LN(p)'
        NCHAR(3)=7
        IVALUE(4)='Degrees of
Freedom'
        NCHAR(4)=21
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NHEAD=4
        NCHAR(1)=0
        IVALUE(1)=' '
        DO5010I=1,NUMSET
          PVAL=TEMP6(I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          CALL DPHTM5(IVALUE,NCHAR(1),AVALUE,NHEAD)
 5010   CONTINUE
C
        NHEAD=4
        CALL DPHTM6(NHEAD)
C
 5160   FORMAT('   ')
 5161   FORMAT('      ')
 5162   FORMAT('      ')
 5170   FORMAT('   ')
C
        WRITE(ICOUT,5160)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
 5166   FORMAT('        SUM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5167)
 5167   FORMAT('         ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5168)SUM2
 5168   FORMAT('        ',F12.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5169)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5169)ISUM
 5169   FORMAT('        ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5170)
        CALL DPWRST('XXX','WRIT')
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
 5105   FORMAT('

')
 5106   FORMAT('
')
        WRITE(ICOUT,5106)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('Ha: There is a Trend for ',
     1         'Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5120I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5120   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Chi-Square
Test Statistic'
        NCHAR(2)=28
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        NHEAD=2
        AVALUE(1)=SUM2
        AVALUE(2)=CV1
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV2
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV3
        IVALUE(1)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
        ITTEMP='Military Handbook Test: Fisher Composite Test'
        NCTEMP=45
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5220I=1,5
          ALIGN(I)='CENTER'
          NUMDI2(I)=0
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5220   CONTINUE
        NUMDI2(2)=-2
        NUMDI2(3)=-2
C
        IVALUE(1)='System'
        NCHAR(1)=6
        IVALUE(2)='P-Value'
        NCHAR(2)=7
        IVALUE(3)='-2LN(p)'
        NCHAR(3)=7
        IVALUE(4)='Degrees of
Freedom'
        NCHAR(4)=21
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NHEAD=4
        NCHAR(1)=0
        IVALUE(1)=' '
        DO5210I=1,NUMSET
          PVAL=TEMP6(MAXSYS+I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          CALL DPHTM5(IVALUE,NCHAR(1),AVALUE,NHEAD)
 5210   CONTINUE
C
        NHEAD=4
        CALL DPHTM6(NHEAD)
C
        WRITE(ICOUT,5160)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5167)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5168)SUM2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5169)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5169)ISUM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5170)
        CALL DPWRST('XXX','WRIT')
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5106)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5230I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5230   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Chi-Square
Test Statistic'
        NCHAR(2)=28
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        NHEAD=2
        AVALUE(1)=SUM2
        AVALUE(2)=CV1
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV2
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV3
        IVALUE(1)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DSUM3=0.0D0
        DO5410I=1,NUMSET
          VAL1=TEMP6(2*MAXSYS+I)
          VAL2=TEMP6(3*MAXSYS+I)
          VAL3=TEMP6(4*MAXSYS+I)
          DSUM1=DSUM1 + DBLE(VAL1)
          DSUM2=DSUM2 + DBLE(VAL2)
          DSUM3=DSUM3 + DBLE(VAL3)
 5410   CONTINUE
        DSUM2=-0.5D0*DSUM2
        Z=REAL((DSUM1 + DSUM2)/DSQRT(DSUM3/12.0D0))
        CALL NORCDF(Z,CDF)
        ALP01=0.01
        CALL NORPPF(ALP01,CV1)
        ALP05=0.05
        CALL NORPPF(ALP05,CV2)
        ALP10=0.10
        CALL NORPPF(ALP10,CV3)
        ALP90=0.90
        CALL NORPPF(ALP90,CV4)
        ALP95=0.95
        CALL NORPPF(ALP95,CV5)
        ALP99=0.99
        CALL NORPPF(ALP99,CV6)
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
        ICONC4='ACCEPT'
        ICONC5='ACCEPT'
        ICONC6='ACCEPT'
        IF(Z.LE.CV1)ICONC1='REJECT'
        IF(Z.LE.CV2)ICONC2='REJECT'
        IF(Z.LE.CV3)ICONC3='REJECT'
        IF(Z.GE.CV4)ICONC4='REJECT'
        IF(Z.GE.CV5)ICONC5='REJECT'
        IF(Z.GE.CV6)ICONC6='REJECT'
C
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
        ITTEMP='Laplace Test: Composite Test'
        NCTEMP=28
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDT1=350
        IWDIT2=150
        NUMDIG=0
C
CCCCC   IVAL2='Number of Failure Times:'
CCCCC   NCH=24
CCCCC   AVAL=REAL(N)
CCCCC   CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        NUMDIG=-2
        IVAL2='Normal Test Statistic Value'
        NCH=27
        AVAL=Z
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Normal Test Statistic CDF Value'
        NCH=31
        AVAL=CDF
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5305)
 5305   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5307)
 5307   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
 5315   FORMAT('Ha: There is a Trend Following a NHPP ',
     1         'Exponential Law Model
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5305)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5320I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5320   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Normal
Test Statistic'
        NCHAR(2)=24
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=Z
        AVALUE(2)=CV1
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV2
        IVALUE(1)='0.05%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV3
        IVALUE(1)='0.10%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(1)=Z
        AVALUE(2)=CV4
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC4(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV5
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC5(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV6
        IVALUE(1)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC6(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Reverse Arrangements Test: Fisher Composite Test'
        NCTEMP=48
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
        NHEAD=0
C
        DO8010I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8010   CONTINUE
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        IFLAG1=.FALSE.
        NHEAD=4
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        IVALUE(1)='System'
        NCHAR(1)=6
        IVALUE(2)='P-Value'
        NCHAR(2)=7
        IVALUE(3)='-2$ ln(p)$'
        IVALUE(3)(4:4)=IBASLC
        NCHAR(3)=10
        IVALUE(4)='Degrees of Freedom'
        NCHAR(4)=18
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=4
        NUMDI2(4)=0
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NCHAR(1)=0
        IVALUE(1)=' '
        DO8020I=1,NUMSET
          PVAL=TEMP6(I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 8020   CONTINUE
C
        WRITE(ICOUT,8021)SUM2,ISUM,IBASLC,IBASLC
 8021   FORMAT(5X,'Sum:  &  & ',F12.5,' & ' ,I8,2X,A1,A1)
        CALL DPWRST('XXX','WRIT')
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: There is a Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Number of'
        NCHAR(2)=9
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Reversals'
        NCHAR(2)=9
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=SUM2
        AVALUE(2)=CV1
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV2
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV3
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Military Handbook Test: Fisher Composite Test'
        NCTEMP=45
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
        NHEAD=0
C
        DO8110I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8110   CONTINUE
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        IFLAG1=.FALSE.
        NHEAD=4
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        IVALUE(1)='System'
        NCHAR(1)=6
        IVALUE(2)='P-Value'
        NCHAR(2)=7
        IVALUE(3)='-2$ ln(p)$'
        IVALUE(3)(4:4)=IBASLC
        NCHAR(3)=10
        IVALUE(4)='Degrees of Freedom'
        NCHAR(4)=18
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=4
        NUMDI2(4)=0
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NCHAR(1)=0
        IVALUE(1)=' '
        DO8120I=1,NUMSET
          PVAL=TEMP6(MAXSYS + I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 8120   CONTINUE
C
        WRITE(ICOUT,8021)SUM2,ISUM,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: There is a Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Chi-Square'
        NCHAR(2)=10
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        NUMDI2(1)=-2
        NUMDI2(2)=-2
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=SUM2
        AVALUE(2)=CV1
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV2
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV3
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DSUM3=0.0D0
        DO8310I=1,NUMSET
          VAL1=TEMP6(2*MAXSYS+I)
          VAL2=TEMP6(3*MAXSYS+I)
          VAL3=TEMP6(4*MAXSYS+I)
          DSUM1=DSUM1 + DBLE(VAL1)
          DSUM2=DSUM2 + DBLE(VAL2)
          DSUM3=DSUM3 + DBLE(VAL3)
 8310   CONTINUE
        DSUM2=-0.5D0*DSUM2
        Z=REAL((DSUM1 + DSUM2)/DSQRT(DSUM3/12.0D0))
        CALL NORCDF(Z,CDF)
        ALP01=0.01
        CALL NORPPF(ALP01,CV1)
        ALP05=0.05
        CALL NORPPF(ALP05,CV2)
        ALP10=0.10
        CALL NORPPF(ALP10,CV3)
        ALP90=0.90
        CALL NORPPF(ALP90,CV4)
        ALP95=0.95
        CALL NORPPF(ALP95,CV5)
        ALP99=0.99
        CALL NORPPF(ALP99,CV6)
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
        ICONC4='ACCEPT'
        ICONC5='ACCEPT'
        ICONC6='ACCEPT'
        IF(Z.LE.CV1)ICONC1='REJECT'
        IF(Z.LE.CV2)ICONC2='REJECT'
        IF(Z.LE.CV3)ICONC3='REJECT'
        IF(Z.GE.CV4)ICONC4='REJECT'
        IF(Z.GE.CV5)ICONC5='REJECT'
        IF(Z.GE.CV6)ICONC6='REJECT'
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Laplace Test: Composite Test'
        NCTEMP=28
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDTH(1)=0
        VALIGN(1)=' '
        ALIGN(1)='l'
        NUMDI2(1)=-2
        IWIDTH(2)=0
        VALIGN(2)=' '
        ALIGN(2)='r'
        NUMDI2(2)=-2
        IFLAG1=.FALSE.
        NHEAD=1
C
 8321   FORMAT(A1,'begin{center}')
 8322   FORMAT(A1,'begin{tabular}{lr}')
        WRITE(ICOUT,8321)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8322)IBASLC
        CALL DPWRST('XXX','WRIT')
C
CCCCC   IVALUE(1)='Number of Failure Times: '
CCCCC   NCHAR(1)=25
CCCCC   AVALUE(1)=REAL(N)
CCCCC   CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic Value: '
        NCHAR(1)=29
        AVALUE(1)=Z
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic CDF Value: '
        NCHAR(1)=33
        AVALUE(1)=CDF
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Exponential Law Model'
        NCHAR2=48
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        DO8320I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=-2
 8320   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Normal'
        NCHAR(2)=6
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
C
        IVALUE(1)='0.01$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV1
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.05$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV2
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.10$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV3
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
C
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC4
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV4
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC5
        NCHAR2=6
        AVALUE(2)=CV5
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC6
        NCHAR2=6
        AVALUE(2)=CV6
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'RTF')THEN
C
 6191   FORMAT(A1,'f',I1)
 6193   FORMAT(A1,'fs',I1)
 6195   FORMAT(A1,'fs',I2)
        CALL DPCONA(92,IBASLC)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Reverse Arrangements Test: Fisher Composite Test'
        NCTEMP=48
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        NUMDI2(1)=0
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        NUMDI2(4)=0
        DO6005I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
 6005   CONTINUE
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1640/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(1) + 2*IINC1
        IWIDTH(4)=IWIDTH(1) + 3*IINC1
C
        IVALUE(1)=' b System'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
        IVALUE(2)=' b P-Value'
        IVALUE(2)(1:1)=IBASLC
        NCHAR(2)=10
        IVALUE(3)=' b -2 LN(p)'
        IVALUE(3)(1:1)=IBASLC
        NCHAR(3)=11
        IVALUE(4)=' b Degrees of line Freedom'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(14:14)=IBASLC
        NCHAR(4)=26
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NCHAR(1)=0
        IFLAG1=.FALSE.
        DO6010I=1,NUMSET
          PVAL=TEMP6(I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          IF(I.EQ.NUMSET)THEN
            IFLAG1=.TRUE.
          ENDIF
          CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6010   CONTINUE
        IFLAG1=.FALSE.
C
        NHEAD=4
        IVALUE(1)= ' b Sum'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=6
        NHEAD=3
        NUMDI2(1)=-1
        NUMDI2(2)=-1
        NUMDI2(3)=-2
        NUMDI2(4)=0
        AVALUE(1)=0.0
        AVALUE(2)=0.0
        AVALUE(3)=SUM2
        AVALUE(4)=REAL(ISUM)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NHEAD=4
        CALL DPRTF6(NHEAD)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: There is a Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NUMDI2(1)=0
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        NUMDI2(4)=0
        IFLAG1=.FALSE.
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO6020I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
 6020   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Chi-Square line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(14:14)=IBASLC
        NCHAR(2)=33
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=SUM2
        AVALUE(3)=CV1
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC2
        AVALUE(3)=CV2
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC3
        AVALUE(3)=CV3
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Military Handbook Test: Fisher Composite Test'
        NCTEMP=45
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        NUMDI2(1)=0
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        NUMDI2(4)=0
        DO6105I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
 6105   CONTINUE
        IDEFPS=20
        IFRST=IRTFPS*1400/IDEFPS
        IINC1=IRTFPS*1640/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(1) + 2*IINC1
        IWIDTH(4)=IWIDTH(1) + 3*IINC1
C
        IVALUE(1)=' b System'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=9
        IVALUE(2)=' b P-Value'
        IVALUE(2)(1:1)=IBASLC
        NCHAR(2)=10
        IVALUE(3)=' b -2 LN(p)'
        IVALUE(3)(1:1)=IBASLC
        NCHAR(3)=11
        IVALUE(4)=' b Degrees of line Freedom'
        IVALUE(4)(1:1)=IBASLC
        IVALUE(4)(14:14)=IBASLC
        NCHAR(4)=26
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        NCHAR(1)=0
        IFLAG1=.FALSE.
        DO6110I=1,NUMSET
          PVAL=TEMP6(MAXSYS+I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          AVALUE(1)=REAL(I)
          AVALUE(2)=PVAL
          AVALUE(3)=ATERM1
          AVALUE(4)=REAL(IDF)
          IF(I.EQ.NUMSET)THEN
            IFLAG1=.TRUE.
          ENDIF
          CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
 6110   CONTINUE
        IFLAG1=.FALSE.
C
        NHEAD=4
        IVALUE(1)= ' b Sum'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=6
        NHEAD=3
        NUMDI2(1)=-1
        NUMDI2(2)=-1
        NUMDI2(3)=-2
        NUMDI2(4)=0
        AVALUE(1)=0.0
        AVALUE(2)=0.0
        AVALUE(3)=SUM2
        AVALUE(4)=REAL(ISUM)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NHEAD=4
        CALL DPRTF6(NHEAD)
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: There is a Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NUMDI2(1)=0
        NUMDI2(2)=-2
        NUMDI2(3)=-2
        NUMDI2(4)=0
        IFLAG1=.FALSE.
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO6120I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
 6120   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Chi-Square line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(14:14)=IBASLC
        NCHAR(2)=33
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=SUM2
        AVALUE(3)=CV1
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC2
        AVALUE(3)=CV2
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC3
        AVALUE(3)=CV3
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DSUM3=0.0D0
        DO6210I=1,NUMSET
          VAL1=TEMP6(2*MAXSYS+I)
          VAL2=TEMP6(3*MAXSYS+I)
          VAL3=TEMP6(4*MAXSYS+I)
          DSUM1=DSUM1 + DBLE(VAL1)
          DSUM2=DSUM2 + DBLE(VAL2)
          DSUM3=DSUM3 + DBLE(VAL3)
 6210   CONTINUE
        DSUM2=-0.5D0*DSUM2
        Z=REAL((DSUM1 + DSUM2)/DSQRT(DSUM3/12.0D0))
        CALL NORCDF(Z,CDF)
        ALP01=0.01
        CALL NORPPF(ALP01,CV1)
        ALP05=0.05
        CALL NORPPF(ALP05,CV2)
        ALP10=0.10
        CALL NORPPF(ALP10,CV3)
        ALP90=0.90
        CALL NORPPF(ALP90,CV4)
        ALP95=0.95
        CALL NORPPF(ALP95,CV5)
        ALP99=0.99
        CALL NORPPF(ALP99,CV6)
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
        ICONC4='ACCEPT'
        ICONC5='ACCEPT'
        ICONC6='ACCEPT'
        IF(Z.LE.CV1)ICONC1='REJECT'
        IF(Z.LE.CV2)ICONC2='REJECT'
        IF(Z.LE.CV3)ICONC3='REJECT'
        IF(Z.GE.CV4)ICONC4='REJECT'
        IF(Z.GE.CV5)ICONC5='REJECT'
        IF(Z.GE.CV6)ICONC6='REJECT'
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Laplace Test: Composite Test'
        NCTEMP=28
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IDEFPS=20
        IFRST=IRTFPS*1400*4/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*1000/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        VALIGN(1)='b'
        VALIGN(2)='b'
        VALIGN(3)='b'
        VALIGN(4)='b'
        ALIGN(1)='l'
        ALIGN(2)='r'
        ALIGN(3)='c'
        ALIGN(4)='c'
        NUMDI2(1)=0
        NUMDI2(2)=0
        NUMDI2(3)=0
        NUMDI2(4)=0
        IFLAG1=.FALSE.
        NHEAD=1
C
CCCCC   IVALUE(1)='Number of Failure Times:'
CCCCC   NCHAR(1)=24
CCCCC   AVALUE(2)=REAL(N)
CCCCC   CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic Value:'
        NCHAR(1)=28
        AVALUE(2)=Z
        NUMDI2(2)=-2
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic CDF Value:'
        NCHAR(1)=32
        AVALUE(2)=CDF
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Exponential Law Model'
        NCHAR2=48
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO7220I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=-2
 7220   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Normal line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(10:10)=IBASLC
        NCHAR(2)=30
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV1
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05%'
        IVAL2=ICONC2
        AVALUE(3)=CV2
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10%'
        IVAL2=ICONC3
        AVALUE(3)=CV3
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC4
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV4
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC5
        AVALUE(3)=CV5
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC6
        AVALUE(3)=CV6
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT(5X,'REVERSE ARRANGEMENTS TEST: FISHER COMPOSITE TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)
 4003   FORMAT('                                            ',
     1         'DEGREES OF')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4005)
 4005   FORMAT('   SYSTEM         P-VALUE         -2*LN(P)     ',
     1         'FREEDOM')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4007)
 4007   FORMAT('================================================',
     1         '======')
        CALL DPWRST('XXX','WRIT')
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        DO4010I=1,NUMSET
          PVAL=TEMP6(I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          WRITE(ICOUT,4011)I,PVAL,ATERM1,IDF
 4011     FORMAT(I8,5X,F12.5,5X,F12.5,5X,I7)
          CALL DPWRST('XXX','WRIT')
 4010   CONTINUE
        WRITE(ICOUT,4007)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)SUM2,ISUM
 4021   FORMAT(3X,'SUM  ',22X,F12.5,I12)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('H0: NO TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4033)
 4033   FORMAT('HA: THERE IS A TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4042)
 4042   FORMAT('SIGNIFICANCE     CHI-SQUARE       CRITICAL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4044)
 4044   FORMAT('   LEVEL       TEST STATISTIC      REGION   ',
     1         'CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4046)
 4046   FORMAT('===============================================',
     1         '=======')
        CALL DPWRST('XXX','WRIT')
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        WRITE(ICOUT,4049)ALP90,SUM2,CV1,ICONC1
 4049   FORMAT(3X,F4.2,'%',6X,F12.5,F12.5,'(>=)',5X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4049)ALP95,SUM2,CV2,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4049)ALP99,SUM2,CV3,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4101)
 4101   FORMAT(5X,'MILITARY HANDBOOK TEST: FISHER COMPOSITE TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4005)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4007)
        CALL DPWRST('XXX','WRIT')
C
        IDF=2
        ISUM=0
        SUM1=0.0
        SUM2=0.0
        DO4110I=1,NUMSET
          PVAL=TEMP6(MAXSYS+I)
          ATERM1=-2.0*LOG(PVAL)
          SUM1=SUM1 + PVAL
          SUM2=SUM2 + ATERM1
          ISUM=ISUM+IDF
          WRITE(ICOUT,4011)I,PVAL,ATERM1,IDF
          CALL DPWRST('XXX','WRIT')
 4110   CONTINUE
        WRITE(ICOUT,4007)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4021)SUM2,ISUM
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4133)
 4133   FORMAT('HA: THERE IS A NHPP POWER LAW TREND FOR ',
     1         'INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4042)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4044)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4046)
        CALL DPWRST('XXX','WRIT')
C
        ALP90=0.90
        CALL CHSPPF(ALP90,ISUM,CV1)
        ALP95=0.95
        CALL CHSPPF(ALP95,ISUM,CV2)
        ALP99=0.99
        CALL CHSPPF(ALP99,ISUM,CV3)
C
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
C
        IF(SUM2.GT.CV1)ICONC1='REJECT'
        IF(SUM2.GT.CV2)ICONC1='REJECT'
        IF(SUM2.GT.CV3)ICONC1='REJECT'
C
        WRITE(ICOUT,4049)ALP90,SUM2,CV1,ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4049)ALP95,SUM2,CV2,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4049)ALP99,SUM2,CV3,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DSUM3=0.0D0
        DO4210I=1,NUMSET
          VAL1=TEMP6(2*MAXSYS+I)
          VAL2=TEMP6(3*MAXSYS+I)
          VAL3=TEMP6(4*MAXSYS+I)
          DSUM1=DSUM1 + DBLE(VAL1)
          DSUM2=DSUM2 + DBLE(VAL2)
          DSUM3=DSUM3 + DBLE(VAL3)
 4210   CONTINUE
        DSUM2=-0.5D0*DSUM2
        Z=REAL((DSUM1 + DSUM2)/DSQRT(DSUM3/12.0D0))
        CALL NORCDF(Z,CDF)
        ALP01=0.01
        CALL NORPPF(ALP01,CV1)
        ALP05=0.05
        CALL NORPPF(ALP05,CV2)
        ALP10=0.10
        CALL NORPPF(ALP10,CV3)
        ALP90=0.90
        CALL NORPPF(ALP90,CV4)
        ALP95=0.95
        CALL NORPPF(ALP95,CV5)
        ALP99=0.99
        CALL NORPPF(ALP99,CV6)
        ICONC1='ACCEPT'
        ICONC2='ACCEPT'
        ICONC3='ACCEPT'
        ICONC4='ACCEPT'
        ICONC5='ACCEPT'
        ICONC6='ACCEPT'
        IF(Z.LE.CV1)ICONC1='REJECT'
        IF(Z.LE.CV2)ICONC2='REJECT'
        IF(Z.LE.CV3)ICONC3='REJECT'
        IF(Z.GE.CV4)ICONC4='REJECT'
        IF(Z.GE.CV5)ICONC5='REJECT'
        IF(Z.GE.CV6)ICONC6='REJECT'
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4532)
 4532   FORMAT(5X,'LAPLACE TEST: COMPOSITE TEST')
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,4534)N
C4534   FORMAT('NUMBER OF FAILURE TIMES           = ',I8)
CCCCC   CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4536)Z
 4536   FORMAT('NORMAL TEST STATISTIC VALUE       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4538)CDF
 4538   FORMAT('NORMAL TEST STATISTIC CDF VALUE   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4574)
 4574   FORMAT('H0: NO TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4576)
 4576   FORMAT('HA: THERE IS A TREND FOLLOWING A NHPP EXPONENTIAL ',
     1         'LAW MODEL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4582)
 4582   FORMAT('SIGNIFICANCE       NORMAL         CRITICAL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4584)
 4584   FORMAT('   LEVEL       TEST STATISTIC      REGION   ',
     1         'CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4586)
 4586   FORMAT('==================================================',
     1         '====')
        CALL DPWRST('XXX','WRIT')
C
 4559   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(<=)',5X,A6)
 4569   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(>=)',5X,A6)
        WRITE(ICOUT,4559)ALP01,Z,CV1,ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4559)ALP05,Z,CV2,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4559)ALP10,Z,CV3,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4569)ALP90,Z,CV4,ICONC4
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4569)ALP95,Z,CV5,ICONC5
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4569)ALP99,Z,CV6,ICONC6
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE2')THEN
        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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPTRE3(Y,N,XTEMP1,XTEMP2,TEND,MAXNXT,
     1                  RATPVA,MHTPVA,DSUM1,DVAL2,DVAL3,
     1                  ISET,ICAPSW,ICAPTY,
     1                  ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A TRENDS ANALYSIS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     NOTE--DPTRE2 CAN LOOP THROUGH MULTIPLE SYSTEMS.
C           THIS ROUTINE IS USED TO COMPUTE THE TESTS FOR
C           A SINGLE SYSTEM.
C     NOTE--3 TRENDS TESTS ARE PERFORMED:
C           1) REVERSE ARRANGEMENT TEST
C           2) MILITARY HANDBOOK TEST
C           3) LAPLACE TEST
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     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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/10
C     ORIGINAL VERSION--OCTOBER   2006. EXTRACTED FROM DPTRE3
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
C
      CHARACTER*4 ISUBRO
      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
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DVAL2
      DOUBLE PRECISION DVAL3
C
      REAL MHTPVA
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      DIMENSION Y(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*50 IVALUE(MAXHED)
      CHARACTER*50 IVAL2
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*1 IBASLC
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
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='E3  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE3')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPTRE3--')
        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) = ',I8,G15.7)
          CALL DPWRST('XXX','BUG ')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)ISET
  111   FORMAT('***** ERROR IN RELIABILITY TREND TEST--SYSTEM ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,113)
  113   FORMAT('      THE NUMBER OF OBSERVATONS IS LESS THAN 2.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)N
  112   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
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,111)ISET
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',G15.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'.OR.ISUBRO.EQ.'TRE3')
     1CALL 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
      AN=REAL(N)
      REXP=AN*(AN-1.0)/4.0
      RVAR=(2.0*AN + 5.0)*(AN - 1.0)*AN/72.0
      RSD=SQRT(RVAR)
C
      R=REAL(IREV)
      ANUM=R + 0.5 - REXP
      Z=ANUM/RSD
      CALL NORCDF(Z,CDF)
      RATPVA=CDF
C
C               *************************
C               **  STEP 11C-          **
C               **  FORM Z STATISTICS  **
C               *************************
C
      ISTEPN='11C'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ALP01=0.01
      CALL NORPPF(ALP01,PPF01)
      ALP05=0.05
      CALL NORPPF(ALP05,PPF05)
      ALP10=0.10
      CALL NORPPF(ALP10,PPF10)
      ALP90=0.90
      CALL NORPPF(ALP90,PPF90)
      ALP95=0.95
      CALL NORPPF(ALP95,PPF95)
      ALP99=0.99
      CALL NORPPF(ALP99,PPF99)
      IF(N.EQ.4)THEN
        IRMN01=-1
        IRMN05=0
        IRMN10=0
        IRMN90=6
        IRMN95=6
        IRMN99=-1
      ELSEIF(N.EQ.5)THEN
        IRMN01=0
        IRMN05=1
        IRMN10=1
        IRMN90=9
        IRMN95=9
        IRMN99=10
      ELSEIF(N.EQ.6)THEN
        IRMN01=1
        IRMN05=2
        IRMN10=3
        IRMN90=12
        IRMN95=13
        IRMN99=14
      ELSEIF(N.EQ.7)THEN
        IRMN01=2
        IRMN05=4
        IRMN10=5
        IRMN90=16
        IRMN95=17
        IRMN99=19
      ELSEIF(N.EQ.8)THEN
        IRMN01=4
        IRMN05=6
        IRMN10=8
        IRMN90=20
        IRMN95=22
        IRMN99=24
      ELSEIF(N.EQ.9)THEN
        IRMN01=6
        IRMN05=9
        IRMN10=11
        IRMN90=25
        IRMN95=27
        IRMN99=30
      ELSEIF(N.EQ.10)THEN
        IRMN01=9
        IRMN05=12
        IRMN10=14
        IRMN90=31
        IRMN95=33
        IRMN99=36
      ELSEIF(N.EQ.11)THEN
        IRMN01=12
        IRMN05=16
        IRMN10=18
        IRMN90=37
        IRMN95=39
        IRMN99=43
      ELSEIF(N.EQ.12)THEN
        IRMN01=16
        IRMN05=20
        IRMN10=23
        IRMN90=43
        IRMN95=46
        IRMN99=50
      ELSEIF(N.GT.12)THEN
        IRMN01=PPF01*RSD + REXP - 0.5
        IRMN05=PPF05*RSD + REXP - 0.5
        IRMN10=PPF10*RSD + REXP - 0.5
        IRMN90=PPF90*RSD + REXP - 0.5
        IRMN95=PPF95*RSD + REXP - 0.5
        IRMN99=PPF99*RSD + REXP - 0.5
      ENDIF
C
      ICONC1='ACCEPT'
      ICONC2='ACCEPT'
      ICONC3='ACCEPT'
      IF(IREV.GE.IRMN90)ICONC1='REJECT'
      IF(IREV.GE.IRMN95)ICONC2='REJECT'
      IF(IREV.GE.IRMN99)ICONC3='REJECT'
C
C               ****************************
C               **  STEP 11D-             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='11D'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        ITTEMP='Reverse Arrangements Test: (System         )'
        WRITE(ITTEMP(36:43),'(I8)')ISET
        NCTEMP=44
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDT1=350
        IWDIT2=150
        NUMDIG=0
C
        IVAL2='Number of Failure Times:'
        NCH=24
        AVAL=REAL(N)
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Observed Number of Reversals:'
        NCH=29
        AVAL=REAL(IREV)
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Maximum Possible Number of Reversals:'
        NCH=38
        AVAL=REAL(IRMAX)
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        NUMDIG=-2
        IVAL2='Expected Number of Reversals:'
        NCH=30
        AVAL=REXP
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Variance for Expected Number of Reversals:'
        NCH=44
        AVAL=RVAR
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Value of Test Statistic (Z-Score):'
        NCH=36
        AVAL=Z
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Z-Score CDF Value:'
        NCH=20
        AVAL=CDF
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5005)
 5005   FORMAT('

')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
 5007   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5011)
 5011   FORMAT('Improvement Test
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
 5013   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
 5015   FORMAT('Ha: There is an Increasing Trend for ',
     1         'Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
 5019   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5020I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=0
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5020   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Number of
Reversals'
        NCHAR(2)=22
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN90)
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN95)
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN99)
        IVALUE(3)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Reverse Arrangements Test: (System         )'
        WRITE(ITTEMP(36:43),'(I8)')ISET
        NCTEMP=44
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDTH(1)=0
        VALIGN(1)=' '
        ALIGN(1)='l'
        NUMDI2(1)=-2
        IWIDTH(2)=0
        VALIGN(2)=' '
        ALIGN(2)='r'
        NUMDI2(2)=-2
        IFLAG1=.FALSE.
        NHEAD=1
C
 8020   FORMAT(A1,'begin{center}')
 8021   FORMAT(A1,'begin{tabular}{lr}')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IVALUE(1)='Number of Failure Times: '
        NCHAR(1)=25
        AVALUE(1)=REAL(N)
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Observed Number of Reversals: '
        NCHAR(1)=30
        AVALUE(1)=REAL(IREV)
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Maximum Possible Number of Reversals:'
        NCHAR(1)=39
        AVALUE(1)=REAL(IRMAX)
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(1)=-2
        IVALUE(1)='Expected Number of Reversals: '
        NCHAR(1)=31
        AVALUE(1)=REXP
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Variance for Expected Number of Reversals: '
        NCHAR(1)=45
        AVALUE(1)=RVAR
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Value of Test Statistic (Z-Score): '
        NCHAR(1)=36
        AVALUE(1)=Z
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Z-Score CDF Value: '
        NCHAR(1)=20
        AVALUE(1)=CDF
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Increasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        DO8010I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8010   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Number of'
        NCHAR(2)=9
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Reversals'
        NCHAR(2)=9
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN90)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN95)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN99)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Reverse Arrangements Test: (System         )'
        WRITE(ITTEMP(36:43),'(I8)')ISET
        NCTEMP=44
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
 6191   FORMAT(A1,'f',I1)
 6193   FORMAT(A1,'fs',I1)
 6195   FORMAT(A1,'fs',I2)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IDEFPS=20
        IFRST=IRTFPS*1400*4/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        VALIGN(1)='b'
        VALIGN(2)='b'
        VALIGN(3)='b'
        VALIGN(4)='b'
        ALIGN(1)='l'
        ALIGN(2)='r'
        ALIGN(3)='c'
        ALIGN(4)='c'
        NUMDI2(1)=0
        NUMDI2(2)=0
        NUMDI2(3)=0
        NUMDI2(4)=0
        IFLAG1=.FALSE.
        NHEAD=1
C
        IVALUE(1)='Number of Failure Times:'
        NCHAR(1)=24
        AVALUE(2)=REAL(N)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Observed Number of Reversals:'
        NCHAR(1)=29
        AVALUE(2)=REAL(IREV)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Maximum Possible Number of Reversals:'
        NCHAR(1)=38
        AVALUE(2)=REAL(IRMAX)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=-2
        IVALUE(1)='Expected Number of Reversals:'
        NCHAR(1)=30
        AVALUE(2)=REXP
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Variance for Expected Number of Reversals:'
        NCHAR(1)=44
        AVALUE(2)=RVAR
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Value of Test Statistic (Z-Score):'
        NCHAR(1)=36
        AVALUE(2)=Z
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Z-Score CDF Value:'
        NCHAR(1)=20
        AVALUE(2)=CDF
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Increasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO7020I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=0
 7020   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Number of line Reversals'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(13:13)=IBASLC
        NCHAR(2)=27
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=REAL(IREV)
        AVALUE(3)=REAL(IRMN90)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC2
        AVALUE(3)=REAL(IRMN95)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC3
        AVALUE(3)=REAL(IRMN99)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,152)ISET
  152   FORMAT(12X,'REVERSE ARRANGEMENTS TEST: (SYSTEM ',I10,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,154)N
  154   FORMAT('NUMBER OF FAILURE TIMES                    = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,156)IREV
  156   FORMAT('OBSERVED NUMBER OF REVERSALS               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,158)IRMAX
  158   FORMAT('MAXIMUM POSSIBLE NUMBER OF REVERSALS       = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,160)REXP
  160   FORMAT('EXPECTED NUMBER OF REVERSALS               = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,162)RVAR
  162   FORMAT('VARIANCE FOR EXPECTED NUMBER OF REVERSALS  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,164)Z
  164   FORMAT('VALUE OF TEST STATISTIC (Z-SCORE)          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,166)CDF
  166   FORMAT('Z-SCORE CDF VALUE                          = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,202)
  202   FORMAT('IMPROVEMENT TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,174)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,204)
  204   FORMAT('HA: THERE IS AN INCREASING TREND FOR INTERARRIVAL  ',
     1         'TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,182)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,184)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,186)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,209)ALP90,IREV,IRMN90,ICONC1
  209   FORMAT(1X,F4.2,'%',5X,I10,3X,I10,'(>=)',7X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,209)ALP95,IREV,IRMN95,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,209)ALP99,IREV,IRMN99,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      ICONC1='ACCEPT'
      ICONC2='ACCEPT'
      ICONC3='ACCEPT'
      IF(IREV.LE.IRMN01)ICONC1='REJECT'
      IF(IREV.LE.IRMN05)ICONC2='REJECT'
      IF(IREV.LE.IRMN10)ICONC3='REJECT'
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
 5061   FORMAT('Degradation Test
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5065)
 5065   FORMAT('Ha: There is an Decreasing Trend for ',
     1         'Interarrival Times
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5005)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5060I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=0
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5060   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Number of
Reversals'
        NCHAR(2)=22
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN01)
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN05)
        IVALUE(1)='0.05%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN10)
        IVALUE(3)='0.10%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Decreasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        DO8070I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8070   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Number of'
        NCHAR(2)=9
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Reversals'
        NCHAR(2)=9
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.01$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN01)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN05)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(1)=REAL(IREV)
        AVALUE(2)=REAL(IRMN10)
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Decreasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Number of line Reversals'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(13:13)=IBASLC
        NCHAR(2)=27
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        DO7040I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=0
 7040   CONTINUE
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=REAL(IREV)
        AVALUE(3)=REAL(IRMN01)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05%'
        IVAL2=ICONC2
        AVALUE(3)=REAL(IRMN05)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10%'
        IVAL2=ICONC3
        AVALUE(3)=REAL(IRMN10)
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        CALL DPRTF6(NHEAD)
C
      ELSE
C
        WRITE(ICOUT,172)
  172   FORMAT('DEGRADATION TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,174)
  174   FORMAT('H0: NO TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,176)
  176   FORMAT('HA: THERE IS A DECLINING TREND FOR INTERARRIVAL  ',
     1         'TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,182)
  182   FORMAT('SIGNIFICANCE   NUMBER OF       CRITICAL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,184)
  184   FORMAT('   LEVEL       REVERSALS        REGION   CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,186)
  186   FORMAT('===================================================')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,192)ALP01,IREV,IRMN01,ICONC1
  192   FORMAT(1X,F4.2,'%',5X,I10,3X,I10,'(<=)',7X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,192)ALP05,IREV,IRMN05,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,192)ALP10,IREV,IRMN10,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               ********************************************
C               **  STEP 21--                             **
C               **  MILITARY HANDBOOK    TEST             **
C               ********************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 21B-                             **
C               **  CALCULATE TEST STATISTIC              **
C               ********************************************
C
      DSUM=0.0D0
      DO310I=1,N
        IF(Y(I).GE.TEND)THEN
          WRITE(ICOUT,311)
  311     FORMAT('***** ERROR FROM MILITARY HANDBOOK TEST--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,312)ISET
  312     FORMAT('      FOR SYSTEM ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,313)TEND
  313     FORMAT('      THE SPECIFIED CENSORING TIME,',G15.7,',')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,314)
  314     FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,316)I,Y(I)
  316     FORMAT('      FAILURE TIME ',I8,' = ',G15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ELSEIF(Y(I).LE.0.0)THEN
          WRITE(ICOUT,311)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,317)I
  317     FORMAT('      FAILURE ',I8,' IS NON-POSITIVE. ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,318)Y(I)
  318     FORMAT('      IT HAS THE VALUE ',G15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        DSUM=DSUM + DLOG(DBLE(TEND/Y(I)))
  310 CONTINUE
      Z=REAL(2.0D0*DSUM)
      INU=2*N
      CALL CHSCDF(Z,INU,CDF)
      MHTPVA=CDF
C
      ALP01=0.01
      CALL CHSPPF(ALP01,INU,CV1)
      ALP05=0.05
      CALL CHSPPF(ALP05,INU,CV2)
      ALP10=0.10
      CALL CHSPPF(ALP10,INU,CV3)
      ALP90=0.90
      CALL CHSPPF(ALP90,INU,CV4)
      ALP95=0.95
      CALL CHSPPF(ALP95,INU,CV5)
      ALP99=0.99
      CALL CHSPPF(ALP99,INU,CV6)
C
      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
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.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        ITTEMP='Military Handbook Test: (System         )'
        WRITE(ITTEMP(33:40),'(I8)')ISET
        NCTEMP=41
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDT1=350
        IWDIT2=150
        NUMDIG=0
C
        IVAL2='Number of Failure Times:'
        NCH=24
        AVAL=REAL(N)
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        NUMDIG=-2
        IVAL2='Chi-Square Test Statistic Value'
        NCH=31
        AVAL=Z
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Chi-Square Test Statistic CDF Value'
        NCH=35
        AVAL=CDF
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5105)
 5105   FORMAT('

')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
 5107   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('Improvement Test
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('Ha: There is a Trend Following a NHPP ',
     1         'Power Law Model
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5119)
 5119   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5105)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5120I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5120   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Chi-Square
Test Statistic'
        NCHAR(2)=28
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=Z
        AVALUE(2)=CV4
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV5
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV6
        IVALUE(3)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Military Handbook Test: (System         )'
        WRITE(ITTEMP(33:40),'(I8)')ISET
        NCTEMP=41
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDTH(1)=0
        VALIGN(1)=' '
        ALIGN(1)='l'
        NUMDI2(1)=-2
        IWIDTH(2)=0
        VALIGN(2)=' '
        ALIGN(2)='r'
        NUMDI2(2)=-2
        IFLAG1=.FALSE.
        NHEAD=1
C
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IVALUE(1)='Number of Failure Times: '
        NCHAR(1)=25
        AVALUE(1)=REAL(N)
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Chi-Square Test Statistic Value: '
        NCHAR(1)=33
        AVALUE(1)=Z
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Chi-Square Test Statistic CDF Value: '
        NCHAR(1)=37
        AVALUE(1)=CDF
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Power Law Model'
        NCHAR2=42
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        DO8210I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=-2
 8210   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Chi-Square'
        NCHAR(2)=10
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV4
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV5
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV6
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Military Handbook Test: (System         )'
        WRITE(ITTEMP(33:40),'(I8)')ISET
        NCTEMP=41
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IDEFPS=20
        IFRST=IRTFPS*1400*4/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*800/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        VALIGN(1)='b'
        VALIGN(2)='b'
        VALIGN(3)='b'
        VALIGN(4)='b'
        ALIGN(1)='l'
        ALIGN(2)='r'
        ALIGN(3)='c'
        ALIGN(4)='c'
        NUMDI2(1)=0
        NUMDI2(2)=0
        NUMDI2(3)=0
        NUMDI2(4)=0
        IFLAG1=.FALSE.
        NHEAD=1
C
        IVALUE(1)='Number of Failure Times:'
        NCHAR(1)=24
        AVALUE(2)=REAL(N)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Chi-Square Test Statistic Value:'
        NCHAR(1)=32
        AVALUE(2)=Z
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Chi-Square Test Statistic CDF Value:'
        NCHAR(1)=36
        AVALUE(2)=CDF
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Power Law Model'
        NCHAR2=42
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO7120I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=-2
 7120   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Chi-Square line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(14:14)=IBASLC
        NCHAR(2)=34
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV4
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC2
        AVALUE(3)=CV5
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC3
        AVALUE(3)=CV6
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,332)ISET
  332   FORMAT(12X,'MILITARY HANDBOOK TEST: (FOR SYSTEM ',I8,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,334)N
  334   FORMAT('NUMBER OF FAILURE TIMES               = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,336)Z
  336   FORMAT('CHI-SQUARE TEST STATISTIC VALUE       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,338)CDF
  338   FORMAT('CHI-SQUARE TEST STATISTIC CDF VALUE   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,340)
  340   FORMAT('IMPROVEMENT TEST')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,354)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,344)
  344   FORMAT('HA: THERE IS A TREND FOLLOWING A NHPP POWER LAW ',
     1         'MODEL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,362)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,364)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,366)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,349)ALP90,Z,CV4,ICONC1
  349   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(>=)',5X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,349)ALP95,Z,CV5,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,349)ALP99,Z,CV6,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      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
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5205)
 5205   FORMAT('

')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5207)
 5207   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5211)
 5211   FORMAT('Improvement Test
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5213)
 5213   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5215)
 5215   FORMAT('Ha: There is a Trend Following a NHPP ',
     1         'Power Law Model
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5219)
 5219   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5205)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5220I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5220   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Chi-Square
Test Statistic'
        NCHAR(2)=28
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=Z
        AVALUE(2)=CV1
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV2
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV3
        IVALUE(3)='0.01%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Decreasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        DO8360I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8360   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Chi-Square'
        NCHAR(2)=10
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.01$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV1
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV2
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV3
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Power Law Model'
        NCHAR2=42
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Chi-Square line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(14:14)=IBASLC
        NCHAR(2)=34
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        DO7140I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=-2
 7140   CONTINUE
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV1
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05%'
        IVAL2=ICONC2
        AVALUE(3)=CV2
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10%'
        IVAL2=ICONC3
        AVALUE(3)=CV3
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        CALL DPRTF6(NHEAD)
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,350)
  350   FORMAT('DEGRADATION TEST')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,354)
  354   FORMAT('H0: NO TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,356)
  356   FORMAT('HA: THERE IS A TREND FOLLOWING A NHPP POWER LAW ',
     1         'MODEL')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,362)
  362   FORMAT('SIGNIFICANCE     CHI-SQUARE       CRITICAL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,364)
  364   FORMAT('   LEVEL       TEST STATISTIC      REGION   ',
     1         'CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,366)
  366   FORMAT('==================================================',
     1         '====')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,392)ALP01,Z,CV1,ICONC1
  392   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(<=)',5X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,392)ALP05,Z,CV2,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,392)ALP10,Z,CV3,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               ********************************************
C               **  STEP 31--                             **
C               **  LAPLACE              TEST             **
C               ********************************************
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 31B-                             **
C               **  CALCULATE TEST STATISTIC              **
C               ********************************************
C
       DSUM=0.0D0
       DSUM1=0.0D0
       DO510I=1,N
         IF(Y(I).GE.TEND)THEN
           WRITE(ICOUT,511)TEND
  511      FORMAT('***** ERROR FROM LAPLACE TREND TEST--')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,512)ISET
  512      FORMAT('      FOR SYSTEM ',I8)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,513)TEND
  513      FORMAT('      THE SPECIFIED CENSORING TIME, ',G15.7)
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,514)
  514      FORMAT('      IS LESS THAN AT LEAST ONE FAILURE TIME.')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,516)I,Y(I)
  516      FORMAT('      FAILURE TIME ',I8,' = ',G15.7)
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         IF(Y(I).LE.0.0)THEN
           WRITE(ICOUT,511)TEND
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,512)ISET
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,521)I
  521      FORMAT('      FAILURE ',I8,' IS NOT POSITIVE.')
           CALL DPWRST('XXX','BUG ')
           WRITE(ICOUT,523)Y(I)
  523      FORMAT('      IT HAS THE VALUE ',G15.7)
           CALL DPWRST('XXX','BUG ')
           IERROR='YES'
           GOTO9000
         ENDIF
         DSUM=DSUM + DBLE(Y(I)-TEND/2.0)
         DSUM1=DSUM1 + DBLE(Y(I))
  510 CONTINUE
      DVAL2=DBLE(N)*DBLE(TEND)
      DVAL3=DBLE(N)*DBLE(TEND)**2
C
      AN=REAL(N)
      Z=REAL(DBLE(SQRT(12.0*AN))*DSUM/DBLE(AN*TEND))
      CALL NORCDF(Z,CDF)
C
      ALP01=0.01
      CALL NORPPF(ALP01,CV1)
      ALP05=0.05
      CALL NORPPF(ALP05,CV2)
      ALP10=0.10
      CALL NORPPF(ALP10,CV3)
      ALP90=0.90
      CALL NORPPF(ALP90,CV4)
      ALP95=0.95
      CALL NORPPF(ALP95,CV5)
      ALP99=0.99
      CALL NORPPF(ALP99,CV6)
C
C               ****************************
C               **  STEP 31B-             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='31B'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TRE3')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      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
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        ITTEMP='Laplace Test: (System         )'
        WRITE(ITTEMP(23:30),'(I8)')ISET
        NCTEMP=31
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDT1=350
        IWDIT2=150
        NUMDIG=0
C
        IVAL2='Number of Failure Times:'
        NCH=24
        AVAL=REAL(N)
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        NUMDIG=-2
        IVAL2='Normal Test Statistic Value'
        NCH=27
        AVAL=Z
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IVAL2='Normal Test Statistic CDF Value'
        NCH=31
        AVAL=CDF
        CALL DPHTM3(IVAL2,NCH,AVAL,NUMDIG,IWIDT1,IWDIT2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
        WRITE(ICOUT,5305)
 5305   FORMAT('

')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5307)
 5307   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5311)
 5311   FORMAT('Improvement Test
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5315)
 5315   FORMAT('Ha: There is a Trend Following a NHPP ',
     1         'Exponential Law Model
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5305)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5320I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5320   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Normal
Test Statistic'
        NCHAR(2)=24
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=Z
        AVALUE(2)=CV4
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV5
        IVALUE(1)='0.95%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV6
        IVALUE(1)='0.99%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        CALL DPCONA(92,IBASLC)
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        ITTEMP='Laplace Test: (System         )'
        WRITE(ITTEMP(23:30),'(I8)')ISET
        NCTEMP=31
        CALL DPLAT8(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        IWIDTH(1)=0
        VALIGN(1)=' '
        ALIGN(1)='l'
        NUMDI2(1)=-2
        IWIDTH(2)=0
        VALIGN(2)=' '
        ALIGN(2)='r'
        NUMDI2(2)=-2
        IFLAG1=.FALSE.
        NHEAD=1
C
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IVALUE(1)='Number of Failure Times: '
        NCHAR(1)=25
        AVALUE(1)=REAL(N)
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic Value: '
        NCHAR(1)=29
        AVALUE(1)=Z
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic CDF Value: '
        NCHAR(1)=33
        AVALUE(1)=CDF
        CALL DPLAT5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Exponential Law Model'
        NCHAR2=48
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
C
        DO8310I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=-2
 8310   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Normal'
        NCHAR(2)=6
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.90$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV4
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.95$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV5
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IVALUE(1)='0.99$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV6
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,
     1              IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        ITEMP2=2.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
C  WRITE HEADER LINE
C
        IRTFMD='OFF'
        CALL DPCONA(92,IBASLC)
        IFLAG1=.TRUE.
        ITTEMP='Laplace Test: (System         )'
        WRITE(ITTEMP(23:30),'(I8)')ISET
        NCTEMP=31
        CALL DPRTF8(ITTEMP,NCTEMP,ITEMP,IFLAG1)
        NHEAD=0
        ITEMP2=1.0*IRTFPS
        IF(ITEMP2.LE.9)THEN
          WRITE(ICOUT,6193)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ELSE
          WRITE(ICOUT,6195)IBASLC,ITEMP2
          CALL DPWRST(ICOUT,'WRIT')
        ENDIF
C
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IDEFPS=20
        IFRST=IRTFPS*1400*4/IDEFPS
        IINC1=IRTFPS*1440/IDEFPS
        IINC2=IRTFPS*1000/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        VALIGN(1)='b'
        VALIGN(2)='b'
        VALIGN(3)='b'
        VALIGN(4)='b'
        ALIGN(1)='l'
        ALIGN(2)='r'
        ALIGN(3)='c'
        ALIGN(4)='c'
        NUMDI2(1)=0
        NUMDI2(2)=0
        NUMDI2(3)=0
        NUMDI2(4)=0
        IFLAG1=.FALSE.
        NHEAD=1
C
        IVALUE(1)='Number of Failure Times:'
        NCHAR(1)=24
        AVALUE(2)=REAL(N)
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic Value:'
        NCHAR(1)=28
        AVALUE(2)=Z
        NUMDI2(2)=-2
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
        IVALUE(1)='Normal Test Statistic CDF Value:'
        NCHAR(1)=32
        AVALUE(2)=CDF
        CALL DPRTF5(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='Improvement Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Exponential Law Model'
        NCHAR2=48
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO7220I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=-2
 7220   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Normal line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(10:10)=IBASLC
        NCHAR(2)=30
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.90%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV4
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.95%'
        IVAL2=ICONC2
        AVALUE(3)=CV5
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.99%'
        IVAL2=ICONC3
        AVALUE(3)=CV6
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,532)ISET
  532   FORMAT(12X,'LAPLACE TEST: (FOR SYSTEM ',I8,')')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,534)N
  534   FORMAT('NUMBER OF FAILURE TIMES           = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,536)Z
  536   FORMAT('NORMAL TEST STATISTIC VALUE       = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,538)CDF
  538   FORMAT('NORMAL TEST STATISTIC CDF VALUE   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,540)
  540   FORMAT('IMPROVEMENT TEST')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,574)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,554)
  554   FORMAT('HA: THERE IS A TREND FOLLOWING A NHPP EXPONENTIAL ',
     1         'LAW MODEL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,582)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,584)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,586)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,559)ALP90,Z,CV4,ICONC1
  559   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(>=)',5X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,559)ALP95,Z,CV5,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,559)ALP99,Z,CV6,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(CDF.GE.0.01)ICONC1='ACCEPT'
      IF(CDF.GE.0.05)ICONC2='ACCEPT'
      IF(CDF.GE.0.1)ICONC3='ACCEPT'
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5405)
 5405   FORMAT('

')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5407)
 5407   FORMAT('
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5411)
 5411   FORMAT('Degradation Test
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5413)
 5413   FORMAT('H0: No Trend for Interarrival Times
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5415)
 5415   FORMAT('Ha: There is a Trend Following a NHPP ',
     1         'Exponential Law Model
    ')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5419)
 5419   FORMAT('
')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5405)
        CALL DPWRST('XXX','WRIT')
C
        ITTEMP=' '
        NCTEMP=0
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPHTM1(ITTEMP,NCTEMP,IFLAG1,IFLAG2)
C
        NHEAD=4
        DO5420I=1,4
          ALIGN(I)='CENTER'
          NUMDI2(I)=-2
          IWIDTH(I)=150
          VALIGN(I)='TOP'
 5420   CONTINUE
        IVALUE(1)='Significance
Level'
        NCHAR(1)=21
        IVALUE(2)='Normal
Test Statistic'
        NCHAR(2)=24
        IVALUE(3)='Critical
Region'
        NCHAR(3)=18
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        CALL DPHTM4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        NHEAD=2
        AVALUE(1)=Z
        AVALUE(2)=CV1
        IVALUE(1)='0.01%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC1(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV2
        IVALUE(1)='0.05%'
        NCHAR(1)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC2(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
        AVALUE(2)=CV3
        IVALUE(1)='0.10%'
        NCHAR(3)=5
        NCHAR2=6
        IVAL2(1:NCHAR2)=ICONC3(1:NCHAR2)
        CALL DPHTM7(IVALUE,NCHAR(1),AVALUE,NHEAD,IVAL2,NCHAR2)
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        CALL DPHTM2(IFLAG1,IFLAG2,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.FALSE.
        CALL DPLAT6(IFLAG1,IFLAG2,IFLAG3)
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Decreasing Trend for Interarrival Times'
        NCHAR2=43
        AVALUE(1)=CPUMIN
        CALL DPLAT7(IVALUE(1),NCHAR2,AVALUE(1))
        DO8370I=1,4
          IWIDTH(I)=100
          VALIGN(1)='BOTTOM'
          ALIGN(I)='c'
          NUMDI2(1)=0
 8370   CONTINUE
        IFLAG1=.FALSE.
C
        IFLAG1=.FALSE.
        NCHAR2=0
        CALL DPLAT1(IVALUE(1),NCHAR2,IVALUE(2),NCHAR2,IFLAG1)
C
        NHEAD=4
        IVALUE(1)='Significance'
        NCHAR(1)=12
        IVALUE(2)='Normal'
        NCHAR(2)=6
        IVALUE(3)='Critical'
        NCHAR(3)=8
        IVALUE(4)=' '
        NCHAR(4)=1
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
        IFLAG3=.TRUE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
        IVALUE(1)='Level'
        NCHAR(1)=5
        IVALUE(2)='Test Statistic'
        NCHAR(2)=14
        IVALUE(3)='Region'
        NCHAR(3)=6
        IVALUE(4)='Conclusion'
        NCHAR(4)=10
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        IFLAG3=.FALSE.
        CALL DPLAT4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2,IFLAG3)
C
        NHEAD=2
        IVALUE(1)='0.01$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(1)=Z
        AVALUE(2)=CV1
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC2
        NCHAR2=6
        AVALUE(2)=CV2
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.10$ %$'
        IVALUE(1)(6:6)=IBASLC
        NCHAR(1)=8
        IVAL2=ICONC3
        NCHAR2=6
        AVALUE(2)=CV3
        CALL DPLAT9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IFLAG1=.TRUE.
        IFLAG2=.TRUE.
        IFLAG3=.TRUE.
        CALL DPLATZ(IFLAG1,IFLAG2,IFLAG3,NHEAD)
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)='Degradation Test'
        NCHAR2=16
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='H0: No Trend for Interarrival Times'
        NCHAR2=35
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        IVALUE(1)='Ha: Trend Following a NHPP Power Law Model'
        NCHAR2=42
        AVALUE(1)=CPUMIN
        CALL DPRTF7(IVALUE(1),NCHAR2,AVALUE(1))
        CALL DPRTF6(NHEAD)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        IVALUE(1)=' '
        IVALUE(2)=' '
        NCHAR2=0
        CALL DPRTF1(IVALUE,NCHAR2,IVALUE(2),NCHAR2)
C
        DO7420I=1,4
          VALIGN(I)='b'
          ALIGN(I)='c'
          NUMDI2(I)=-2
 7420   CONTINUE
        IFRST=IRTFPS*2000/IDEFPS
        IINC1=IRTFPS*1600/IDEFPS
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
        IWIDTH(3)=IWIDTH(2) + IINC1
        IWIDTH(4)=IWIDTH(3) + IINC1
C
        IVALUE(1)=' b Significance line Level'
        IVALUE(1)(1:1)=IBASLC
        IVALUE(1)(16:16)=IBASLC
        NCHAR(1)=26
        IVALUE(2)=' b Normal line Test Statistic'
        IVALUE(2)(1:1)=IBASLC
        IVALUE(2)(10:10)=IBASLC
        NCHAR(2)=29
        IVALUE(3)=' b Critical line Region'
        IVALUE(3)(1:1)=IBASLC
        IVALUE(3)(12:12)=IBASLC
        NCHAR(3)=23
        IVALUE(4)=' b Conclusion'
        IVALUE(4)(1:1)=IBASLC
        NCHAR(4)=13
        NHEAD=4
        IFLAG1=.FALSE.
        IFLAG2=.TRUE.
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
        IFLAG2=.FALSE.
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        IVALUE(1)='0.10%'
        NCHAR(1)=5
        IVAL2=ICONC1
        NCHAR2=6
        AVALUE(2)=Z
        AVALUE(3)=CV1
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.05%'
        IVAL2=ICONC2
        AVALUE(3)=CV2
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
        IVALUE(1)='0.01%'
        IVAL2=ICONC3
        AVALUE(3)=CV3
        CALL DPRTF9(IVALUE,NCHAR(1),AVALUE,NHEAD,IFLAG1,IVAL2,NCHAR2)
C
        IFLAG1=.FALSE.
        NHEAD=2
C
        CALL DPRTF6(NHEAD)
        IF(IRTFFP.EQ.'Times New Roman')THEN
          ITEMP=0
        ELSEIF(IRTFFP.EQ.'Lucida Sans')THEN
          ITEMP=6
        ELSEIF(IRTFFP.EQ.'Arial')THEN
          ITEMP=2
        ELSEIF(IRTFFP.EQ.'Bookman')THEN
          ITEMP=3
        ELSEIF(IRTFFP.EQ.'Georgia')THEN
          ITEMP=4
        ELSEIF(IRTFFP.EQ.'Tahoma')THEN
          ITEMP=5
        ELSEIF(IRTFFP.EQ.'Verdana')THEN
          ITEMP=7
        ELSE
          ITEMP=0
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
      ELSE
C
        WRITE(ICOUT,570)
  570   FORMAT('DEGRADATION TEST')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,574)
  574   FORMAT('H0: NO TREND FOR INTERARRIVAL TIMES')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,554)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,582)
  582   FORMAT('SIGNIFICANCE       NORMAL         CRITICAL')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,584)
  584   FORMAT('   LEVEL       TEST STATISTIC      REGION   ',
     1         'CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,586)
  586   FORMAT('==================================================',
     1         '====')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,592)ALP01,Z,CV1,ICONC1
  592   FORMAT(1X,F4.2,'%',8X,F12.5,1X,F12.5,'(<=)',5X,A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,592)ALP05,Z,CV2,ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,592)ALP10,Z,CV3,ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'TRE3')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPTRE3--')
        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),XTEMP1(I)
 9017     FORMAT('I,Y(I),XTEMP1(I) = ',I8,2G15.7)
          CALL DPWRST('XXX','BUG ')
 9016   CONTINUE
      ENDIF
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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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     UPDATED         --OCTOBER   2006.  CALL LIST TO TCDF/TPPF
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,REAL(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,REAL(IDF),CUTL95)
      CALL TPPF(.975,REAL(IDF),CUTU95)
      CALL TPPF(.005,REAL(IDF),CUTL99)
      CALL TPPF(.995,REAL(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('
')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('')
 5094   FORMAT('
')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5094)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('
')
 5194   FORMAT('
')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5194)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf 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,REAL(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,REAL(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,REAL(IDF),CUTL95)
      CALL TPPF(.975,REAL(IDF),CUTU95)
      CALL TPPF(.005,REAL(IDF),CUTL99)
      CALL TPPF(.995,REAL(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('
')
        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('')
 5594   FORMAT('
')
        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('
')
 5694   FORMAT('
')
        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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  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                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 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