      SUBROUTINE DPSEPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPSEPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
     1MAXSEG,ISEGPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR A SEGMENT.
C              THE PATTERN FOR SEGMENT I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ISEGPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C                     --MAXSEG
C     OUTPUT ARGUMENTS--ISEGPA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              PATTERN FOR SEGMENT I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFPA
      CHARACTER*4 ISEGPA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ISEGPA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PATT')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFPA
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'5')IHOLD='DA5'
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXSEG
      ISEGPA(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ISEGPA(I)
 1136 FORMAT('ALL SEGMENT PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPSEPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE SEGMENT ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE SEGMENT IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      SEGMENT 3 PATTERN SOLID')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXSEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSEPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE SEGMENT ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF SEGMENTS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXSEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'SEGMENT.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'5')IHOLD='DA5'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ISEGPA(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ISEGPA(I)
 1186 FORMAT('THE PATTERN FOR SEGMENT ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSEQ(IHARG,IARGT,IARG,NUMARG,
     1ISEQSW,NUMSEQ,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SEQUENCE SWITCH ISEQSW
C              AND THE START SEQUENCE NUMBER NUMSEQ .
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ISEQSW   ('ON'  OR 'OFF')
C                     --NUMSEQ   (AN INTEGER)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 ISEQSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1110
      IF(NUMARG.EQ.1)GOTO1120
      IF(NUMARG.GE.2)GOTO1130
      GOTO1190
C
 1110 CONTINUE
      ISEQSW='ON'
      NUMSEQ=1
      GOTO1150
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO1122
      IF(IHARG(1).EQ.'OFF')GOTO1124
      IF(IHARG(1).EQ.'AUTO')GOTO1122
      IF(IHARG(1).EQ.'DEFA')GOTO1124
      IF(IARGT(1).EQ.'NUMB')GOTO1126
      GOTO1190
C
 1122 CONTINUE
      ISEQSW='ON'
      NUMSEQ=1
      GOTO1150
C
 1124 CONTINUE
      ISEQSW='OFF'
      NUMSEQ=1
      GOTO1160
C
 1126 CONTINUE
      ISEQSW='ON'
      NUMSEQ=IARG(1)
      GOTO1150
C
 1130 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO1132
      IF(IHARG(1).EQ.'OFF')GOTO1134
      IF(IHARG(1).EQ.'AUTO')GOTO1132
      IF(IHARG(1).EQ.'DEFA')GOTO1134
      GOTO1190
C
 1132 CONTINUE
      ISEQSW='ON'
      IF(IARGT(2).EQ.'NUMB')NUMSEQ=IARG(2)
      IF(IARGT(2).NE.'NUMB')NUMSEQ=1
      GOTO1150
C
 1134 CONTINUE
      ISEQSW='OFF'
      NUMSEQ=1
      GOTO1160
C
 1150 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1159
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('THE SEQUENCE SWITCH HAS JUST BEEN TURNED ON')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)NUMSEQ
 1156 FORMAT('(STARTING WITH SEQUENCE NUMBER ',I8,')')
      CALL DPWRST('XXX','BUG ')
 1159 CONTINUE
      GOTO1180
C
 1160 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1165)
 1165 FORMAT('THE SEQUENCE SWITCH HAS JUST BEEN TURNED OFF')
      CALL DPWRST('XXX','BUG ')
 1169 CONTINUE
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      GOTO1190
C
 1190 CONTINUE
      RETURN
      END
      SUBROUTINE DPSEQU(IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A SEQUENCE.
C              GENERATE ELEMENTS OF A SEQUENCE
C              BY THE FORM (FOR EXAMPLE) LET Y = SEQUENCE 1 .01 10
C              OR BY THE ALTERNATE FORM   LET Y = 1 .01 10
C              (FOR A FULL VARIABLE OR PART OF A VARIABLE).
C     OUTPUT--NECESSARILY A VARIABLE.
C              EXAMPLE--LET Y    = 1 .01 10                  (A FULL VARIABLE)
C                     --LET Y    = 1 .01 10  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = 1 .01 10  FOR I = 1 2 10  (A PARTIAL VAR.)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (IN DPLET)--DECEMBER  1977.
C     UPDATED         --MAY       1982.
C     ORIGINAL VERSION AS A SEPARATE SUBROUTINE--MARCH 1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JUNE      1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --APRIL     1987.
C     UPDATED         --DECEMBER  1988.  SHORTEN: LET Y = SEQU X
C     UPDATED         --DECEMBER  1988.  PARAM TO VAR COLUMN BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
CCCCC THE FOLLOWING LINE WAS INSERTED (DECEMBER 1988)
CCCCC TO FIX A PARAMETER TO VARIABLE COLUMN BUG (DECEMBER 1988)
      CHARACTER*4 IPTOV
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSE'
      ISUBN2='QU  '
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
      I2=0
      NLEFT=0
      ICOLL=0
      N2=0
      NRAWSE=0
      NNUM=0
      NS2=0
      NS2MOD=0
C
      START=0.0
      REPS=1.0
      AINC=0.0
      STOP=0.0
C
      ILEFT='UNKN'
      ILEFT2='UNKN'
C
CCCCC THE FOLLOWING LINE WAS INSERTED (DECEMBER 1988)
CCCCC TO FIX A PARAMETER TO VARIABLE COLUMN BUG (DECEMBER 1988)
      IPTOV='NO'
C
C               ********************************************************
C               **  TREAT THE SUBCASE OF GENERATING ELEMENTS          **
C               **  (EXPRESSED ON THE RIGHT AS 3 CONSTANTS--          **
C               **  START VALUE, INCREMENT, STOP VALUE)               **
C               **       1) FOR A FULL VARIABLE, OR                   **
C               **       2) FOR PART OF A VARIABLE.                   **
C               ********************************************************
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 DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=5
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
CCCCC THE FOLLOWING LINE WAS INSERTED (DECEMBER 1988)
CCCCC TO FIX A PARAMETER TO VARIABLE COLUMN BUG (DECEMBER 1988)
      IPTOV='YES'
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X = 1 2 9         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 1 2 9')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               ****************************************************************
C               **  STEP 4--                                                   *
C               **  EXAMINE THE RIGHT-HAND SIDE--                              *
C               **  DO WE HAVE 3 OR 4 CONSTANTS,                               *
C               **  OR 3 OR 4 PARAMETERS,                                      *
C               **  OR A MIXTURE OF CONSTANTS AND PARAMETERS?                  *
C               **  (ALL OF THE ABOVE ARE ALLOWED.)                            *
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT (DECEMBER 1988)
CCCCC AND REPLACED BY THE SUCCEEDING 2 LINES (DECEMBER 1988)
CCCCC SO THAT  SEQUENCE  NEED NOT BE SPELLED OUT FULLY. (DECEMBER 1988)
CCCCC IF(IHARG(3).EQ.'SEQU'.AND.IHARG2(3).EQ.'ENCE'.AND.
CCCCC1NUMARG.GE.6)GOTO1290
      IF(IHARG(3).EQ.'SEQU'.AND.
     1NUMARG.GE.6)GOTO1290
      IF(NUMARG.GE.5)GOTO1290
 1210 CONTINUE
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      THERE SHOULD BE AT LEAST 3')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      NUMBERS OR WORDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      TO THE RIGHT OF    SEQUENCE    OR   =')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      FOR THIS TYPE OF LET COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      NUMAM2=NUMARG-2
      WRITE(ICOUT,1218)NUMAM2
 1218 FORMAT('      NUMBER OF SUCH NUMBERS/WORDS FOUND = ',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
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT (DECEMBER 1988)
CCCCC AND REPLACED BY THE SUCCEEDING LINE (DECEMBER 1988)
CCCCC SO THAT  SEQUENCE  NEED NOT BE SPELLED OUT FULLY. (DECEMBER 1988)
CCCCC IF(IHARG(3).EQ.'SEQU'.AND.IHARG2(3).EQ.'ENCE')GOTO1302
      IF(IHARG(3).EQ.'SEQU')GOTO1302
 1301 CONTINUE
      NUMPAR=4
      IF(NUMARG.LE.5)NUMPAR=3
      IF(IHARG(6).EQ.'SUBS'.AND.IHARG2(6).EQ.'ET')NUMPAR=3
      IF(IHARG(6).EQ.'EXCE'.AND.IHARG2(6).EQ.'PT')NUMPAR=3
      IF(IHARG(6).EQ.'FOR'.AND.IHARG2(6).EQ.'    ')NUMPAR=3
      GOTO1309
 1302 CONTINUE
      NUMPAR=4
      IF(NUMARG.LE.6)NUMPAR=3
      IF(IHARG(7).EQ.'SUBS'.AND.IHARG2(7).EQ.'ET')NUMPAR=3
      IF(IHARG(7).EQ.'EXCE'.AND.IHARG2(7).EQ.'PT')NUMPAR=3
      IF(IHARG(7).EQ.'FOR'.AND.IHARG2(7).EQ.'    ')NUMPAR=3
      GOTO1309
 1309 CONTINUE
C
 1310 CONTINUE
      ILOCA=3
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT (DECEMBER 1988)
CCCCC AND REPLACED BY THE SUCCEEDING LINE (DECEMBER 1988)
CCCCC SO THAT  SEQUENCE  NEED NOT BE SPELLED OUT FULLY. (DECEMBER 1988)
CCCCC IF(IHARG(3).EQ.'SEQU'.AND.IHARG2(3).EQ.'ENCE')ILOCA=4
      IF(IHARG(3).EQ.'SEQU')ILOCA=4
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO1311
      IF(IARGT(ILOCA).EQ.'WORD')GOTO1312
      GOTO1370
 1311 CONTINUE
      START=ARG(ILOCA)
      GOTO1319
 1312 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      START=VALUE(ILOC)
 1319 CONTINUE
C
 1320 CONTINUE
      REPS=1.0
      IF(NUMPAR.LE.3)GOTO1329
      ILOCA=ILOCA+1
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO1321
      IF(IARGT(ILOCA).EQ.'WORD')GOTO1322
      GOTO1370
 1321 CONTINUE
      REPS=ARG(ILOCA)
      GOTO1329
 1322 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      REPS=VALUE(ILOC)
 1329 CONTINUE
C
 1330 CONTINUE
      ILOCA=ILOCA+1
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO1331
      IF(IARGT(ILOCA).EQ.'WORD')GOTO1332
      GOTO1370
 1331 CONTINUE
      AINC=ARG(ILOCA)
      GOTO1339
 1332 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      AINC=VALUE(ILOC)
 1339 CONTINUE
C
 1340 CONTINUE
      ILOCA=ILOCA+1
      IF(IARGT(ILOCA).EQ.'NUMB')GOTO1341
      IF(IARGT(ILOCA).EQ.'WORD')GOTO1342
      GOTO1370
 1341 CONTINUE
      STOP=ARG(ILOCA)
      GOTO1349
 1342 CONTINUE
      IH=IHARG(ILOCA)
      IH2=IHARG2(ILOCA)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      STOP=VALUE(ILOC)
 1349 CONTINUE
      GOTO1390
C
 1370 CONTINUE
      WRITE(ICOUT,1371)
 1371 FORMAT('***** INTERNAL ERROR IN DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1372)
 1372 FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1373)
 1373 FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1374)IHARG(ILOCA),IHARG2(ILOCA)
 1374 FORMAT('      ARGUMENT                  = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1375)ILOCA
 1375 FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1376)IARGT(ILOCA)
 1376 FORMAT('      ARGUMENT TYPE             = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1377)
 1377 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1378)(IANS(I),I=1,IWIDTH)
 1378 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1390 CONTINUE
      IF(START.EQ.STOP)AINC=0.0
      IF(START.LT.STOP.AND.AINC.LT.0.0)AINC=-AINC
      IF(START.GT.STOP.AND.AINC.GT.0.0)AINC=-AINC
      IFOUND='YES'
C
C               **************************************************************
C               **  STEP 6--                                                **
C               **  GENERATE    NRAWSE         NUMBERS                      **
C               **  IN   THE RAW SEQUENCE.                                  **
C               **  STORE THEM TEMPORARILY IN                               **
C               **  THE VECTOR Y(.).                                        **
C               **  GENERATE THE VALUES FOR THE VARIABLE.                   **
C               **  IT IS OF THE FORM--                                     **
C               **  LET Z    = CONSTANT1  CONSTANT2  CONSTANT3              **
C               **  LET Z    = PARAMETER1  PARAMETER2  PARAMETER3           **
C               **  NOTE THAT COULD ALSO HAVE                               **
C               **  LET Z    = CONSTANT1  PARAMETER2  PARAMETER3            **
C               **  AND ALL OTHER SUCH MIXTURES.                            **
C               **  THIS IS THE IMPLICIT GENERATE COMMAND                   **
C               **  WHICH GENERATES A VARIABLES STARTING WITH               **
C               **  THE VALUE CONSTANT1 AND INCREMENTING BY CONSTANT2       **
C               **  UNTIL IT ARIVES AT THE LAST VALUE NOT LARGER (SMALLER)  **
C               **  THAN CONSTANT3.                                         **
C               **  THE OUTPUT IS NECESSARILY A VARIABLE.                   **
C               **************************************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(AINC.EQ.0.0)N2=MAXN
      IF(AINC.NE.0.0)N2=((STOP-START)/AINC)
      IF(N2.LT.0)N2=-N2
      N2=N2+10
      IF(N2.GT.MAXN)N2=MAXN
C
      IREP=1
      IF(REPS.LE.1.0)IREP=1
      IF(REPS.GT.1.0)IREP=REPS+0.5
C
      K=0
      DO1400I=1,N2
      AI=I
      YCALC=START+(AI-1.0)*AINC
      DO1410J=1,IREP
      K=K+1
      IF(K.GT.MAXN)GOTO1450
      Y(K)=YCALC
 1410 CONTINUE
      IF(I.EQ.1)GOTO1400
      IF(AINC.EQ.0.0)GOTO1400
      IF(START.LT.STOP.AND.YCALC.GT.STOP)GOTO1460
      IF(START.GT.STOP.AND.YCALC.LT.STOP)GOTO1460
 1400 CONTINUE
      NRAWSE=K
      GOTO1490
 1450 CONTINUE
      NRAWSE=K-1
      GOTO1490
 1460 CONTINUE
      NRAWSE=K-IREP
      GOTO1490
 1490 CONTINUE
C
C               ***********************************************************
C               **  STEP 7--                                             **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO1590
      WRITE(ICOUT,1551)
 1551 FORMAT('OUTPUT FROM MIDDLE OF DPSEQU AFTER THE RAW SEQUENCE ',
     1'HAS BEEN GENERATED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1552)NRAWSE
 1552 FORMAT('NRAWSE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NRAWSE.LE.0)GOTO1590
      DO1554I=1,NRAWSE
      WRITE(ICOUT,1555)I,Y(I)
 1555 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 1554 CONTINUE
C
 1590 CONTINUE
C
C               *****************************************
C               **  STEP 8--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)           **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1670
      DO1610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1630
 1610 CONTINUE
      GOTO1680
C
 1620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1680
C
 1630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1680
C
 1670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1671)
 1671 FORMAT('***** INTERNAL ERROR IN DPSEQU')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1672)
 1672 FORMAT('      AT BRANCH POINT 1671--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1673)
 1673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1674)
 1674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1675)NUMARG
 1675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1676)
 1676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1677)(IANS(I),I=1,IWIDTH)
 1677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO1690
      WRITE(ICOUT,1681)NUMARG,ILOCQ,ICASEQ
 1681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
 1690 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NNUM)                   **
C               **  OF        NUMBERS TO BE GENERATED.              **
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO1710
      IF(ICASEQ.EQ.'SUBS')GOTO1720
      IF(ICASEQ.EQ.'FOR')GOTO1730
C
 1710 CONTINUE
CCCCC IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
CCCCC IF(NEWNAM.EQ.'YES')NIISUB=NRAWSE
      NIISUB=NRAWSE
      DO1715I=1,NIISUB
      ISUB(I)=1
 1715 CONTINUE
      NS=NIISUB
      NNUM=NIISUB
      GOTO1750
C
 1720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NNUM=NS
      GOTO1750
C
 1730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NNUM=NS
      GOTO1750
C
 1750 CONTINUE
C
C               ******************************************************
C               **  STEP 10--                                       **
C               **  COPY THE        SEQUENCE                        **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      NS2MOD=0
      DO2100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO2100
      NS2=NS2+1
      NS2MOD=NS2MOD+1
      IF(NS2.EQ.1)IROW1=I
      IF(NS2MOD.GT.NRAWSE)NS2MOD=NS2MOD-NRAWSE
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2MOD)
      IROWN=I
 2100 CONTINUE
      NNUM=NS2
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.NRAWSE)NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.NRAWSE)NINEW=NRAWSE
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=NIISUB
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
CCCCC THE FOLLOWING LINE WAS INSERTED (DECEMBER 1988)
CCCCC TO FIX A PARAMETER TO VARIABLE COLUMN BUG (DECEMBER 1988)
      IF(NEWNAM.EQ.'NO'.AND.IPTOV.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO2400J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO2405
      GOTO2400
 2405 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 2400 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO2459
      IF(IFEEDB.EQ.'OFF')GOTO2459
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)ILEFT,ILEFT2,NNUM
 2411 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,V(IJ),IROW1
 2421    FORMAT('THE FIRST           COMPUTED VALUE OF ',
     1   A4,A4,' = ',E15.7,'   (ROW ',I6,')')
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP1)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,PRED(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP2)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,RES(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP3)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,YPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP4)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,XPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP5)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,X2PLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP6)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,TAGPLO(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(NNUM.NE.1)THEN
         IF(ICOLL.LE.MAXCOL)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,V(IJ),IROWN
 2431       FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',
     1      A4,A4,' = ',E15.7,'   (ROW ',I6,')')
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP1)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,PRED(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP2)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,RES(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP3)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP4)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP5)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ELSE IF(ICOLL.EQ.MAXCP6)THEN
            WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
            CALL DPWRST('XXX','BUG ')
         ENDIF
      ENDIF
C
      IF(NNUM.NE.1)GOTO2449
      WRITE(ICOUT,2441)
 2441 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2442)
 2442 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 2449 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2451)ILEFT,ILEFT2,ICOLL
 2451 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2453)ILEFT,ILEFT2,NINEW
 2453 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2459 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 DPSEQU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3,IBUGQ
 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)MAXN,N2,NRAWSE,NS2,NS2MOD,NNUM
 9015 FORMAT('MAXN,N2,NRAWSE,NS2,NS2MOD,NNUM = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NNUM
 9016 FORMAT('NS,NIISUB,NNUM = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)START,REPS,AINC,STOP
 9017 FORMAT('START,REPS,AINC,STOP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)NLEFT,NRAWSE,NIISUB,IROW1,IROWN,NINEW
 9018 FORMAT('NLEFT,NRAWSE,NIISUB,IROW1,IROWN,NINEW = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)ILEFT,ILEFT2,NEWNAM,ICOLL,NINEW
 9019 FORMAT('ILEFT,ILEFT2,NEWNAM,ICOLL,NINEW = ',A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)REPS,IREP
 9021 FORMAT('REPS,IREP = ',E15.7,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED (DECEMBER 1988)
CCCCC TO FIX A PARAMETER TO VARIABLE COLUMN BUG (DECEMBER 1988)
      WRITE(ICOUT,9022)IPTOV,NUMCOL
 9022 FORMAT('IPTOV,NUMCOL = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSERI(IFROW1,IFROW2,IFCOL1,IFCOL2,ISKIP,INTINF,
CCCCC MARCH 1996.  ADD IMALEV TO ARGUMENT LIST
     1IMACRO,IMACNU,IMACCS,IOSW,IMALEV,
     1IREARW,
     1ICOMCH,ICOMSW,
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE
     1NUMRCM,
     1IFCOLL,IFCOLU,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC ICOMCH, ICOMSW ADDED TO ARGUMENT LIST MAY, 1990.
C
C     PURPOSE--READ IN THE VALUES OF A VARIABLE.
C              THE DATA IS LISTED SERIALLY ACROSS
C              A LINE IMAGE
C              (E.G., X(1) X(2) X(3) ETC.)
C              THE DATA IS READ FROM A MASS STORAGE FILE
C              OR (IF NO FILE GIVEN) FROM THE DEFAULT INPUT UNIT
C              (WHICH WILL BE THE TERMINAL).
C     ASSUMPTION--THE INPUT  FILE ALREADY EXISTS;
C                 (THAT IS, DATAPLOT WILL AUTOMATICALLY
C                 OPEN THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,AX ...)
C                 BUT WILL NOT AUTOMATICALLY CREATE THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,UP ...))
C     ASSUMPTION--THE COMPUTER SYSTEM IS SUCH THAT
C                 EQUATING THE FILE NAME TO
C                 THE FORTRAN NUMERIC DESIGNATION
C                 OF 31 (OR HOWEVER THE VARIABLE    IREANU    IS DEFINED
C                 IN INITFO) IS PERMISSIBLE.
C     NOTE--INPUT FOR THE READ COMMAND MAY POTENTIALLY
C           COME FROM 2 DIFFERENT SOURCES--
C                1) THE TERMINAL ITSELF;
C                2) A FILE;
C           DIFFERENT SYSTEMS ALLOW DIFFERENT COMBINATIONS
C           OF THE ABOVE.
C           ALL SYSTEMS WILL ALLOW INPUT FROM THER TERMINAL ITSELF;
C           MOST SYSTEMS WILL ALLOW INPUT FROM A FILE;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --FEBRUARY  1988.    (DEACT. COL. LIM. IF READ NON-FILE)
C     UPDATED         --DECEMBER  1988.    CORRECT BOMB ON 2ND   READ PARAMETER
C     UPDATED         --MAY       1989.    FIX IRIS PROBLEM--LOOP MAX & CPUMAX
C     UPDATED         --MAY       1990.    1) CHECK FOR COMMENT CHARACTER
C                                          2) ERROR CHECK FOR FORMATTED READ
C     UPDATED         --JULY      1990.    ICOMFL RENAMED AS ICOMSW
C     UPDATED         --SEPTEMBER 1995.  ROW LIMITS & BLANK LINES PROBLEM
C     UPDATED         --FEBRUARY  2003.  SUPPORT FOR LONGER DATA LINES
C     UPDATED         --DECEMBER  2004.  DO NOT ALLOW TERMINAL READ
C                                        WHILE RUNNING THE GUI.
C     UPDATED         --APRIL     2005.  ARGUMENT LIST TO DPREAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
C
      CHARACTER*4 IOSW
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 ICASEA
      CHARACTER*4 IECASE
      CHARACTER*4 ISTOR1
      CHARACTER*4 ISTOR2
      CHARACTER*4 ISTOR3
      CHARACTER*4 IEND
      CHARACTER*4 JVNAM1
      CHARACTER*4 JPNAM1
      CHARACTER*4 JMNAM1
      CHARACTER*4 JFNAM1
      CHARACTER*4 JUNAM1
      CHARACTER*4 JENAM1
      CHARACTER*4 JVNAM2
      CHARACTER*4 JPNAM2
      CHARACTER*4 JMNAM2
      CHARACTER*4 JFNAM2
      CHARACTER*4 JUNAM2
      CHARACTER*4 JENAM2
      CHARACTER*4 IH1
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IOFILE
      CHARACTER*4 IOTERM
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*80 ICANS
CCCCC CHARACTER*80 ISTRIN
C
      CHARACTER*4 ICASRE
C
      CHARACTER*4 ICASTO
C
      CHARACTER*4 IREARW
C  FOLLOWING 3 LINES MAY, 1990.
CCCCC CHARACTER*80 IAJUNK
      CHARACTER*4 ICOMCH
      CHARACTER*4 ICOMSW
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1995
      CHARACTER*4 LINETY
C
      CHARACTER*4 IB
C
      INTEGER IFCOLL(*)
      INTEGER IFCOLU(*)
      INTEGER ITYPE(50)
C
      PARAMETER (MAXRDV=100)
      PARAMETER (MAXCHV=20)
C
      DIMENSION JVNAM1(MAXRDV)
      DIMENSION JPNAM1(MAXRDV)
      DIMENSION JMNAM1(MAXRDV)
      DIMENSION JFNAM1(MAXRDV)
      DIMENSION JUNAM1(MAXRDV)
      DIMENSION JENAM1(MAXRDV)
C
CCCCC DIMENSION NIV(MAXRDV)
C
      DIMENSION JVNAM2(MAXRDV)
      DIMENSION JPNAM2(MAXRDV)
      DIMENSION JMNAM2(MAXRDV)
      DIMENSION JFNAM2(MAXRDV)
      DIMENSION JUNAM2(MAXRDV)
      DIMENSION JENAM2(MAXRDV)
C
      DIMENSION IEN(MAXRDV)
      DIMENSION IECOL2(MAXRDV)
      DIMENSION IECASE(MAXRDV)
      DIMENSION PVAL(MAXRDV)
      DIMENSION IFSTA2(MAXRDV)
      DIMENSION IFSTO2(MAXRDV)
C
      DIMENSION X0(140)
      CHARACTER*24 IXC(140)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
      DIMENSION ISTOR1(MAXRCL)
      DIMENSION ISTOR2(MAXRCL)
      DIMENSION ISTOR3(MAXRCL)
      DIMENSION IB(MAXRCL)
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='DPSE'
      ISUBN2='RI  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      IOFILE='-999'
      IOTERM='-999'
C
CCCCC THE FOLLOWING LINE WAS INSERTED MAY 1989
      IBILLI=INT(10.0**9 + 0.01)
C
      I2=0
      NUMVRD=0
C
      ICASRE='VARI'
      MAXN2=MAXCHF
C
      NCALL=0
      NCOLS=0
C
C               ***************************
C               **  TREAT THE READ CASE  **
C               ***************************
C
      MAXV2=100
      MAXP2=100
      MAXM2=100
      MAXF2=100
      MAXU2=100
      MAXE2=100
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1995
      LINETY='-999'
C
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPSERI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IFROW1,IFROW2
   52   FORMAT('IFROW1,IFROW2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IFCOL1,IFCOL2,NUMRCM
   53   FORMAT('IFCOL1,IFCOL2,NUMRCM = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)ISKIP,INTINF,IBUGS2,IBUGQ
   54   FORMAT('ISKIP,INTINF,IBUGS2,IBUGQ = ',I8,I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)IOSW
   55   FORMAT('IOSW = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)IMACRO,IMACNU,IMACCS
   56   FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,58)IRD,IRD2
   58   FORMAT('IRD,IRD2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)IBUGS2,ISUBRO,IERROR
   63   FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,64)IWIDTH
   64   FORMAT('IWIDTH = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,65)(IANSLC(I),I=1,IWIDTH)
   65     FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,71)IREANU
   71   FORMAT('IREANU = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)IREANA
   72   FORMAT('IREANA = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,73)IREAST
   73   FORMAT('IREAST = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,74)IREAFO
   74   FORMAT('IREAFO = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,75)IREAAC
   75   FORMAT('IREAAC = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,76)IREAFO
   76   FORMAT('IREAFO = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,77)IREACS
   77   FORMAT('IREACS = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,86)IREARW
   86   FORMAT('IREARW = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.1)THEN
        IERROR='YES'
        GOTO8800
      ENDIF
C
C               *******************************************************
C               **  STEP 2A--                                        **
C               **  DETERMINE THE TYPE OF READ CASE--                **
C               **       1) FROM TERMINAL;                           **
C               **       2) FROM FILE;                               **
C               **  NOTE--IOTERM  WILL = 'YES' ONLY IN EXPLICIT      **
C               **        TERMINAL CASE.                             **
C               **        (THAT IS, ONLY WHEN INPUT IOSW             **
C               **        = 'TERM')                                  **
C               **  NOTE--IOFILE  WILL = 'YES' ONLY IN FILE CASE.    **
C               *******************************************************
C
      ISTEPN='2A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  200 CONTINUE
      IWORD=3
      CALL DPFILE(IANSLC,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
C
      IOTERM='NO'
      IF(IOFILE.EQ.'NO'.AND.IOSW.EQ.'TERM')IOTERM='YES'
C
CCCCC DECEMBER 2004.  IF GUI RUNNING, DO NOT ALLOW TERMINAL READ.
C
      IF(IOFILE.EQ.'NO' .AND. IGUIFL.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,211)
  211   FORMAT('***** ERROR FROM READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,213)
  213   FORMAT('      TERMINAL READS (I.E., READ WITH NO FILE NAME ',
     1         'SPECIFIED)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,215)
  215   FORMAT('      ARE NOT PERMITTED WHEN RUNNING DATAPLOT FROM ',
     1         'THE GRAPHICAL USER INTERFACE)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,217)
  217   FORMAT('      ALTERNATIVELY, YOU CAN DO ONE OF THE FOLLOWING:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,219)
  219   FORMAT('      1) YOU CAN ENTER THE DATA DIRECTLY FROM THE ',
     1         'DATASHEET.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,221)
  221   FORMAT('      2) FROM THE COMMAND LINE WINDOW, YOU CAN USE ',
     1         'THE DATA COMMAND AS FOLLOWS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,223)
  223   FORMAT('         LET Y = DATA value1 value2 ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,225)
  225   FORMAT('      3) THE FIRST TWO METHODS ARE USEFUL FOR SMALL ',
     1         'AMOUNTS OF DATA.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,227)
  227   FORMAT('         FOR MORE THAN A FEW DATA POINTS, IT IS ',
     1         'RECOMMENDED THAT YOU')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,229)
  229   FORMAT('         CREATE THE DATA IN AN ASCII FILE AND THEN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,231)
  231   FORMAT('         READ THE DATA FROM THAT FILE.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************
C               **  STEP 2B--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  COPY OVER VARIABLES            **
C               *************************************
C
      ISTEPN='2B'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO1190
C
      IOUNIT=IREANU
      IFILE=IREANA
      ISTAT=IREAST
      IFORM=IREAFO
      IACCES=IREAAC
      IPROT=IREAPR
      ICURST=IREACS
C
      ISUBN0='SERI'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,1183)IOUNIT
 1183   FORMAT('IOUNIT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1184)IFILE
 1184   FORMAT('IFILE = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1185)ISTAT,IFORM,IACCES,IPROT,ICURST
 1185   FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1         A12,2X,A12,2X,A12,2X,A12,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1186)ISUBN0,IERRFI
 1186   FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
 1190 CONTINUE
C
C               ***********************************************
C               **  STEP 2C--                                **
C               **  IF HAVE THE FILE INPUT CASE--            **
C               **  CHECK TO SEE IF THE READ FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='2C'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES' .AND. ISTAT.EQ.'NONE')THEN
        IERROR='YES'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1211)
 1211   FORMAT('***** IMPLEMENTATION ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1212)
 1212   FORMAT('      THE DESIRED READING CANNOT BE CARRIED OUT ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1214)
 1214   FORMAT('      BECAUSE THE INTERNAL VARIABLE    IREAST ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1215)
 1215   FORMAT('      WHICH ALLOWS SUCH READING HAS BEEN SET TO ',
     1         '   NONE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1217)ISTAT,IREAST
 1217   FORMAT('ISTAT,IREAST = ',A12,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1218)
 1218   FORMAT('      ALL READING MUST BE DONE DIRECTLY FROM THE ',
     1         'TERMINAL.')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
C
C               *************************************
C               **  STEP 2D--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  EXTRACT THE FILE NAME          **
C               *************************************
C
      ISTEPN='2D'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        DO1310I=1,80
          ICANS(I:I)=IANSLC(I)
 1310   CONTINUE
C
        ISTART=1
        ISTOP=IWIDTH
        IWORD=3
        CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1              ICOL1,ICOL2,IFILE,NCFILE,
     1              IBUGS2,ISUBRO,IERROR)
C
        IF(NCFILE.LT.1)THEN
          IERROR='YES'
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1341)
 1341     FORMAT('***** ERROR IN SERIAL READ--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1342)
 1342     FORMAT('      A USER FILE NAME IS REQUIRED IN THE ',
     1           'READ COMMAND')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1344)
 1344     FORMAT('      (FOR EXAMPLE,    READ CALIB.DAT X Y Z)')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1345)
 1345     FORMAT('      BUT NONE WAS GIVEN HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1346)
 1346     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,1347)(IANSLC(I),I=1,IWIDTH)
 1347       FORMAT('      ',80A1)
          ELSE
            WRITE(ICOUT,999)
          ENDIF
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
C
      ENDIF
C
C               *************************************
C               **  STEP 2E--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  OPEN THE FILE                  **
C               *************************************
C
      ISTEPN='2E'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        IREWIN='ON'
        IF(IREACS(1:4).EQ.'CLOS')THEN
          CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
          IREACS='OPEN'
        ENDIF
        IF(IERRFI.EQ.'YES')GOTO9000
      ENDIF
C
C               ******************************************
C               **  STEP 2F--                           **
C               **  FOR THE 2 CASES--                   **
C               **      1) TERMINAL INPUT;              **
C               **      2) FILE INPUT;                  **
C               **  DEFINE THE INPUT READ UNIT NUMBER,  **
C               **  AND OTHER VARIABLES NEEDED          **
C               **  FOR UPCOMING READS.                 **
C               ******************************************
C
      ISTEPN='2F'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IRD2=IRD
CCCCC IF(IMACST.EQ.'OPFI')IRD2=IMACNU
CCCCC MARCH 1996.  BUG IF READ DONE WITHIN A MACRO AFTER A NESTED MACRO
CCCCC CALLED.
CCCCC IF(IMACCS.EQ.'OPEN')IRD2=IMACNU
      IF(IMACCS.EQ.'OPEN'.OR.IMALEV.GE.1)THEN
        IRD2=IMACNU+IMALEV-1
      ENDIF
      IF(IOFILE.EQ.'YES')IRD2=IREANU
      IF(IOTERM.EQ.'YES')IRD2=IRD
C
      IOUNIT=IRD2
      IDEV='SERI'
C
C               *****************************************
C               **  STEP 3--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET; OR                    **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO390
      DO300J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO310
        IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO310
        IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO320
  300 CONTINUE
      GOTO390
  310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO390
  320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO390
  390 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,391)NUMARG,ILOCQ
  391   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 4--                                         **
C               **  DETERMINE THE TYPE AND NUMBER OF ITEMS           **
C               **  TO BE READ   .                                   **
C               **  NUMALL = TOTAL NUMBER OF READ  ITEMS             **
C               **           (AS DETERMINED BY INCLUDING ONLY ALL    **
C               **           BEFORE 'SUBSET' OR 'EXCEPT' OR 'FOR')   **
C               **  NUMV   = NUMBER OF VARIABLES TO BE READ    ;     **
C               **  NUMP   = NUMBER OF PARAMETERS TO BE READ    ;    **
C               **  NUMM   = NUMBER OF MODELS TO BE READ             **
C               **           (SHOULD = 0 OR 1)                       **
C               **  NUMF   = NUMBER OF FUNCTIONS TO BE READ          **
C               **  NUMU   = NUMBER OF UNKNOWNS TO BE READ    ;      **
C               **  NUME   = TOTAL NUMBER OF READ  ITEMS             **
C               **           (SHOULD = NUMALL);                      **
C               *******************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMALL=ILOCQ-1
      IF(IOFILE.EQ.'YES')NUMALL=ILOCQ-2
C
      IV=0
      IP=0
      IM=0
      IF=0
      IU=0
      IE=0
      IH1=' '
      IH2=' '
      JMIN=2
      IF(IOFILE.EQ.'YES')JMIN=3
      JMAX=ILOCQ-1
      IF(JMIN.GT.JMAX)GOTO4290
      DO4200J=JMIN,JMAX
        IH1=IHARG(J)
        IH2=IHARG2(J)
C
C       ***************
C       THE FOLLOWING CODE ALLOWS THE    TO    KEYWORD
C       TO BE ACTIVATED, AS IN
C       SERIAL READ FILE.EXT Y1 TO Y10
C       DECEMBER 1986
C       ***************
C
        ICASTO='OFF'
        IF (IH1.EQ.'TO  ')GOTO4210
        GOTO4220
C
 4210   CONTINUE
        ICASTO='ON'
        JM1=J-1
        JP1=J+1
        CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
     1              KNUMB,IVAL1,IVAL2,IBUGS2,ISUBRO,IERROR)
C
        IVA1P1=IVAL1+1
        IVA2M1=IVAL2-1
        IF(IVA1P1.GT.IVA2M1)GOTO4200
        IVAL=IVAL1
 4215   CONTINUE
        IVAL=IVAL+1
        IF(IVAL.GE.IVAL2)GOTO4200
C
        CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
     1              IH1,IH2,IBUGS2,ISUBRO,IERROR)
        GOTO4220
C
 4220   CONTINUE
        ICASEA='    '
        DO4300I=1,NUMNAM
          I2=I
          IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))GOTO4305
          GOTO4300
 4305   CONTINUE
        IF(IUSE(I).EQ.'V')GOTO4310
        IF(IUSE(I).EQ.'P')GOTO4320
        IF(IUSE(I).EQ.'M')GOTO4330
        IF(IUSE(I).EQ.'F')GOTO4340
 4300   CONTINUE
        ICASEA='U'
        GOTO4350
C
 4310   CONTINUE
        ICASEA='V'
        IV=IV+1
        IF(IV.GT.MAXV2)GOTO4370
        JVNAM1(IV)=IH1
        JVNAM2(IV)=IH2
        GOTO4370
C
 4320   CONTINUE
        ICASEA='P'
        IP=IP+1
        IF(IP.GT.MAXP2)GOTO4370
CCCCC   THE FOLLOWING 2 CORRECTIONS WERE MADE IN DECEMBER 1988
CCCCC   TO CORRECT THE BOMB OF    READ PARAMETER   UPON 2ND USAGE
CCCCC   JPNAM1(IV)=IH1
CCCCC   JPNAM2(IV)=IH2
        JPNAM1(IP)=IH1
        JPNAM2(IP)=IH2
        PVAL(IP)=VALUE(I2)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4321)
 4321   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4322)
 4322   FORMAT('      A NAME IN THE LIST OF VARIABLES TO BE READ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4324)
 4324   FORMAT('      INCLUDED THE NAME OF A PREVIOUSLY-DEFINED ',
     1         'PARAMETER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4326)IH1,IH2
 4326   FORMAT('      THE NAME OF THE PARAMETER WAS ',2A4,'  .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4327)
 4327   FORMAT('      NO READ WAS CARRIED OUT.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
C
 4330   CONTINUE
        ICASEA='M'
        IM=IM+1
        IF(IM.GT.MAXM2)GOTO4370
        JMNAM1(IM)=IH1
        JMNAM2(IM)=IH2
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4331)
 4331   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4332)
 4332   FORMAT('      A NAME IN THE LIST OF VARIABLES TO BE READ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4334)
 4334   FORMAT('      INCLUDED THE NAME OF A PREVIOUSLY-DEFINED ',
     1         'MODEL.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4336)IH1,IH2
 4336   FORMAT('      THE NAME OF THE MODEL WAS ',2A4,'  .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4337)
 4337   FORMAT('      NO READ WAS CARRIED OUT.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
C
 4340   CONTINUE
        ICASEA='F'
        IF=IF+1
        IF(IF.GT.MAXF2)GOTO4370
        JFNAM1(IF)=IH1
        JFNAM2(IF)=IH2
        IFSTA2(IF)=IVSTAR(I2)
        IFSTO2(IF)=IVSTOP(I2)
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4341)
 4341   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4342)
 4342   FORMAT('      A NAME IN THE LIST OF VARIABLES TO BE READ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4344)
 4344   FORMAT('      INCLUDED THE NAME OF A PREVIOUSLY-DEFINED ',
     1         'FUNCTION.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4346)IH1,IH2
 4346   FORMAT('      THE NAME OF THE FUNCTION WAS ',2A4,'  .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4347)
 4347   FORMAT('      NO READ WAS CARRIED OUT.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
C
 4350   CONTINUE
        ICASEA='U'
        IU=IU+1
        IF(IU.GT.MAXU2)GOTO4370
        JUNAM1(IU)=IH1
        JUNAM2(IU)=IH2
        GOTO4370
C
 4370   CONTINUE
        IE=IE+1
        IF(IE.GT.MAXE2)GOTO4380
        JENAM1(IE)=IH1
        JENAM2(IE)=IH2
        IECASE(IE)='NEW'
        IF(ICASEA.EQ.'V')IECASE(IE)='OLD'
        IECOL2(IE)=-1
        IF(ICASEA.EQ.'V')IECOL2(IE)=IVALUE(I2)
CCCCC   NOVEMBER 2002.  FIX FOLLOWING LINE FOR "TO" CASE.
CCCCC   GOTO4200
        GOTO4280
C
 4380   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4381)
 4381   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4382)
 4382   FORMAT('      THE NUMBER OF NAMES IN THE READ COMMAND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4383)
 4383   FORMAT('      HAS JUST EXCEEDED THE ALLOWABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4384)MAXE2
 4384   FORMAT('      MAXIMUM (',I5,')')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
C
 4280   CONTINUE
        IF(ICASTO.EQ.'ON')GOTO4215
C
 4200 CONTINUE
 4290 CONTINUE
      NUMV=IV
      NUMP=IP
      NUMM=IM
      NUMF=IF
      NUMU=IU
      NUME=IE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,4411)NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME
 4411   FORMAT('NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME = ',7I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4412)
 4412   FORMAT('I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1  JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)')
        CALL DPWRST('XXX','BUG ')
        DO4420I=1,15
          WRITE(ICOUT,4421)I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1    JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)
 4421     FORMAT(I8,5X,2A4,1X,2A4,1X,2A4,1X,2A4,1X,2A4)
          CALL DPWRST('XXX','BUG ')
 4420   CONTINUE
      ENDIF
C
C               ***************************************************
C               **  STEP 5--                                     **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (1 TO 100) OF VARIABLES TO BE READ           **
C               **  (NOTE--THIS DOES NOT INCLUDE PARAMETERS      **
C               **  OR MODELS IN THE ABOVE COUNT--               **
C               **  ONLY VARIABLES.)                             **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF CONSTANTS TO BE READ   .       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF MODELS TO BE READ   .          **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF FUNCTIONS TO BE READ   .       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (1 TO 100) OF UNKNOWNS TO BE READ   .        **
C               ***************************************************
C
      IF(NUMV.LT.0 .OR. NUMV.GT.MAXV2)THEN
C
        WRITE(ICOUT,511)
  511   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,512)
  512   FORMAT('      FOR A READ, THE NUMBER OF VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,513)
  513   FORMAT('      (NOT COUNTING PARAMETERS OR MODELS)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,514)MAXV2
  514   FORMAT('      MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,515)
  515   FORMAT('      SUCH WAS NOT THE CASE HERE;  THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,517)NUMV
  517   FORMAT('      NUMBER OF VARIABLES TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,518)MAXV2
  518   FORMAT('      NOTE--ONLY THE FIRST ',I8,' VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,519)
  519   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,520)
  520   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,521)(IANSLC(I),I=1,MAX(80,IWIDTH))
  521     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(NUMP.LT.0 .OR. NUMP.GT.MAXP2)THEN
        WRITE(ICOUT,531)
  531   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,532)
  532   FORMAT('      FOR A READ, THE NUMBER OF PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,534)MAXP2
  534   FORMAT('      (CONSTANTS) MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,535)
  535   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,537)NUMP
  537   FORMAT('      NUMBER OF PARAMETERS TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,538)MAXP2
  538   FORMAT('      NOTE--ONLY THE FIRST ',I8,' PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,539)
  539   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,540)
  540   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,541)(IANSLC(I),I=1,MAX(80,IWIDTH))
  541     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(NUMM.LT.0 .OR. NUMM.GT.MAXM2)THEN
C
        WRITE(ICOUT,551)
  551   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,552)
  552   FORMAT('      FOR A READ, THE NUMBER OF MODELS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,554)MAXM2
  554   FORMAT('      MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,555)
  555   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,557)NUMM
  557   FORMAT('      NUMBER OF MODELS TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,558)MAXM2
  558   FORMAT('      NOTE--ONLY THE FIRST ',I8,' MODELS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,559)
  559   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,560)
  560   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,561)(IANSLC(I),I=1,MAX(80,IWIDTH))
  561     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(NUMF.LT.0 .OR. NUMM.GT.MAXF2)THEN
C
        WRITE(ICOUT,571)
  571   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,572)
  572   FORMAT('      FOR A READ, THE NUMBER OF FUNCTIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,574)MAXF2
  574   FORMAT('      MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,575)
  575   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,577)NUMF
  577   FORMAT('      NUMBER OF FUNCTIONS TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,578)MAXF2
  578   FORMAT('      NOTE--ONLY THE FIRST ',I8,' FUNCTIONS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,579)
  579   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,560)
  580   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,581)(IANSLC(I),I=1,MAX(80,IWIDTH))
  581     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(NUMU.LT.0 .OR. NUMU.GT.MAXU2)THEN
C
        WRITE(ICOUT,611)
  611   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,612)
  612   FORMAT('      FOR A READ, THE NUMBER OF UNKNOWNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,614)MAXU2
  614   FORMAT('      MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,615)
  615   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,617)NUMU
  617   FORMAT('      NUMBER OF UNKNOWNS TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,618)MAXU2
  618   FORMAT('      NOTE--ONLY THE FIRST ',I8,' UNKNOWNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,619)
  619   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,620)
  620   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,621)(IANSLC(I),I=1,MAX(80,IWIDTH))
  621     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(NUME.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4451)
 4451   FORMAT('***** ERROR IN SERIAL READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4452)
 4452   FORMAT('      NO VARIABLE NAMES WERE PROVIDED IN THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4453)
 4453   FORMAT('      READ STATEMENT, HENCE NO READ WAS CARRIED OUT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4454)
 4454   FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4455)
 4455   FORMAT('      THE PROPER FORM FOR THE READ COMMAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4456)
 4456   FORMAT('      SUPPOSE THE ANALYST WISHES TO READ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4457)
 4457   FORMAT('      DATA FROM THE FILE    CALIB.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4458)
 4458   FORMAT('      INTO THE INTERNAL VARIABLES Y, X1, AND X2;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4459)
 4459   FORMAT('      THIS IS DONE BY ENTERING THE COMMAND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4460)
 4460   FORMAT('      READ CALIB. Y X1 X2')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
      ENDIF
C
C               *******************************************************
C               **  STEP 6--                                         **
C               **  THOSE NAMES WHICH ARE OF THE UNKNOWN CATEGORY    **
C               **  WILL BECOME  FUTURE VARIABLES.                   **
C               **  ASSIGN THESE VARIABLES TO THE NEXT AVAILABLE     **
C               **  COLUMNS, AND UPDATE THE NAME TABLE ACCORDINGLY.  **
C               *******************************************************
C
      IF(NUME.GT.0)THEN
        INAM=NUMNAM
        ICOL=NUMCOL
        DO700IE=1,NUME
          IF(IECOL2(IE).GE.1)GOTO700
          INAM=INAM+1
          ICOL=ICOL+1
C
          IF(INAM.GT.MAXNAM)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,711)
  711       FORMAT('***** ERROR IN SERIAL READ--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,712)
  712       FORMAT('      THE NUMBER OF NAMES')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,713)
  713       FORMAT('      (PARAMETERS + VARIABLES + FUNCTIONS)')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,714)
  714       FORMAT('      HAS JUST EXCEEDED THE MAXIMUM SIZE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,715)MAXNAM
  715       FORMAT('      (',I5,') OF THE INTERNAL NAME TABLE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO8800
          ENDIF
C
          IF(ICOL.GT.MAXCOL)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,721)
  721       FORMAT('***** ERROR IN SERIAL READ--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,722)
  722       FORMAT('      THE NUMBER OF COLUMNS IN THE INTERNAL ',
     1             'DATAPLOT')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,724)
  724       FORMAT('      DATA ARRAY HAS JUST EXCEEDED THE ALLOWABLE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,725)MAXCOL
  725       FORMAT('      MAXIMUM (',I5,')')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO8800
          ENDIF
C
          IHNAME(INAM)=JENAM1(IE)
          IHNAM2(INAM)=JENAM2(IE)
          IUSE(INAM)='V'
          IVALUE(INAM)=ICOL
          IECOL2(IE)=ICOL
          IN(INAM)=0
  700   CONTINUE
        NUMNAM=INAM
        NUMCOL=ICOL
      ENDIF
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,791)NUMNAM,NUMCOL
  791   FORMAT('NUMNAM,NUMCOL = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 7--                                         **
C               **  FIRST, BRANCH TO THE APPROPRIATE SUBCASE         **
C               **  (DEPENDING ON WHETHER UNQUALIFIED, SUBSET OR FOR);*
C               **  THE DETERMINE THE LENGTH OF THE LONGEST          **
C               **  VARIABLE TO BE READ    IN ;                      **
C               **  THEN READ IN  THE VARIABLES                      **
C               **  THAT WERE SPECIFIED.                             **
C               *******************************************************
C
      ISTEPN='7'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXNRD=MAXN
      IF(ICASEQ.EQ.'FULL')GOTO7310
      IF(ICASEQ.EQ.'SUBS')GOTO7320
      IF(ICASEQ.EQ.'FOR')GOTO7330
C
 7310 CONTINUE
      DO7315I=1,MAXNRD
      ISUB(I)=1
 7315 CONTINUE
      NQ2=MAXNRD
      GOTO7350
C
 7320 CONTINUE
      NIOLD=MAXNRD
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ2=NIOLD
      GOTO7350
C
 7330 CONTINUE
      NIOLD=MAXNRD
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ2=NFOR
      GOTO7350
C
 7350 CONTINUE
C
C               *******************************************
C               **  STEP 8--                             **
C               **  IF A DATA ROW MINIMUM EXISTS AND SO  **
C               **  OUR ATTENTION IS FOCUSED ONLY ON     **
C               **  CERTAIN ROWS OF THE DATA FILE,       **
C               **  THEN GO DOWN TO THE FIRST SUCH ROW   **
C               **  IN THE FILE.                         **
C               *******************************************
C
      ISTEPN='8'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFROW1.LE.1)GOTO7369
        IFRMIN=1
        IFRMAX=IFROW1-1
        IF(IFRMIN.GT.IFRMAX)GOTO7369
        MINCO2=1
        MAXCO2=NUMRCM
        IF(IRD2.EQ.IRD)MAXCO2=80
        IFCOL3=IFCOL1
        IFCOL4=IFCOL2
C       THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C       TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A
C       NON-FILE (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A
C       MACRO).
        IF(IOFILE.EQ.'NO')IFCOL3=MINCO2
        IF(IOFILE.EQ.'NO')IFCOL4=MAXCO2
        IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
C
        DO7360IFROW=IFRMIN,IFRMAX
          IF(IOFILE.EQ.'NO')THEN
            READ(IRD2,7362,END=7363)IJUNK
 7362       FORMAT(A1)
          ELSEIF(IOFILE.EQ.'YES')THEN
            NUMCHA=-1
            CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                  IA,NUMCHA,
     1                  ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
          ENDIF
C
          IF(IERROR.EQ.'YES')GOTO8800
          IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1      NUMCHA.EQ.3)GOTO7363
          GOTO7360
 7363     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7364)
 7364     FORMAT('***** ERROR IN SERIAL READ--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7365)
 7365     FORMAT('      END OF FILE ENCOUNTERED WHILE SKIPPING OVER',
     1           'HEADER LINES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7367)
 7367     FORMAT('      NOTE SKIP AND ROW LIMITS SETTINGS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7368)ISKIP,IFROW1,IFROW2
 7368     FORMAT('      ISKIP,IFROW1,IFROW2 = ',3I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO8800
C
 7360   CONTINUE
 7369 CONTINUE
C
C               *******************************************
C               **  STEP 9--                             **
C               **  IN ADDITION, IF HEADER (= NON-DATA)  **
C               **  LINES EXIST WHICH ARE TO BE SKIPPED  **
C               **  OVER IN THE READ, DO SO HERE.        **
C               *******************************************
C
      ISTEPN='9'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'NO')GOTO7389
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFROW1.LE.1)THEN
          WRITE(ICOUT,7371)
 7371     FORMAT('THE NUMBER OF HEADER LINES')
          CALL DPWRST('XXX','BUG ')
        ELSE
          WRITE(ICOUT,7372)
 7372     FORMAT('THE NUMBER OF (ADDITIONAL) HEADER LINES')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,7373)ISKIP
 7373   FORMAT('    BEING SKIPPED = ',I6)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(ISKIP.LE.0)GOTO7389
      IFRMIN=IFROW1
      IFRMAX=IFROW1+ISKIP-1
      IF(IFRMIN.GT.IFRMAX)GOTO7389
      MINCO2=1
      MAXCO2=NUMRCM
      IF(IRD2.EQ.IRD)MAXCO2=80
      IFCOL3=IFCOL1
      IFCOL4=IFCOL2
C     THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C     TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A NON-FILE
C     (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO).
      IF(IOFILE.EQ.'NO')THEN
        IFCOL3=MINCO2
        IFCOL4=MAXCO2
      ENDIF
      IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
      DO7380IFROW=IFRMIN,IFRMAX
        IF(IOFILE.EQ.'NO')THEN
          READ(IRD2,7382,END=7383)IJUNK
 7382     FORMAT(A1)
        ELSE IF(IOFILE.EQ.'YES')THEN
          NUMCHA=-1
          CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IA,NUMCHA,
     1                ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
        ENDIF
C
        IF(IERROR.EQ.'YES')GOTO8800
        IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1    NUMCHA.EQ.3)GOTO7383
        GOTO7380
C
 7383   CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7384)
 7384     FORMAT('***** ERROR IN SERIAL READ--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7385)
 7385     FORMAT('      END OF FILE ENCOUNTERED WHILE SKIPPING ',
     1           'HEADER LINES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7387)
 7387     FORMAT('      NOTE SKIP AND ROW LIMITS SETTINGS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7388)ISKIP,IFROW1,IFROW2
 7388     FORMAT('      ISKIP,IFROW1,IFROW2 = ',3I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO8800
C
 7380   CONTINUE
 7389 CONTINUE
C
C               ************************
C               **  STEP 10--         **
C               **  READ IN THE DATA  **
C               ************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7210)NUME
 7210   FORMAT('NUME = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7211)IRD,IRD2
 7211   FORMAT('IRD,IRD2 = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      DO7260I=1,MAXRCL
        ISTOR1(I)='    '
        ISTOR2(I)='    '
        ISTOR3(I)='    '
        IB(I)='    '
 7260 CONTINUE
C
      IF(NUME.GT.0)THEN
        DO7300I=1,NUME
          IEN(I)=0
 7300   CONTINUE
      ENDIF
C
      MINCO2=1
      MAXCO2=NUMRCM
      IF(IRD2.EQ.IRD)MAXCO2=80
      IFCOL3=IFCOL1
      IFCOL4=IFCOL2
C     THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C     TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A NON-FILE
C     (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO).
      IF(IOFILE.EQ.'NO')THEN
        IFCOL3=MINCO2
        IFCOL4=MAXCO2
      ENDIF
      IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
C
      I=0
C
      IE2=0
      IE3=0
C
      NUMLRD=0
      IENDTY=1
      IFRMIN=IFROW1+ISKIP
      IFRMAX=IFROW2
      IF(IHOST1.EQ.'CDC'.AND.IFRMAX.GT.130000)IFRMAX=130000
CCCCC THE FOLLOWING LINE WAS INSERTED APRIL 1989
      IF(IFRMAX.GE.IBILLI)IFRMAX=IBILLI
      IF(IFRMIN.GT.IFRMAX)GOTO7470
      DO7400IFROW=IFRMIN,IFRMAX
        CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,
     1              IXC,NXC,
     1              ICASRE,IFUNC2,N2,MAXN2,
     1              IMACRO,IMACNU,IMACCS,
     1              IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD,
     1              IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1              ICOMCH,ICOMSW,LINETY,IGRPAU,
     1              IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL,IREADL,
     1              PREAMV,MAXRDV,MAXCHV,
     1              IDECPT,
     1              IB,
     1              IERRFI,IBUGS2,ISUBRO,IERROR)
CCCCC   ICOMCH AND ICOMFFL ADDED TO ARGUMENT LIST MAY, 1990.
CCCCC   THE    LINETY   ARGUMENT ADDED ABOVE      SEPTEMBER 1995
CCCCC   THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1995
        IF(LINETY.EQ.'BLAN')GOTO7400
        NUMLRD=NUMLRD+1
C
        IF(IERROR.EQ.'YES')GOTO8800
        IF(IFROW.EQ.IFRMIN)THEN
          DO7425K=1,132
            ISTOR3(K)=ISTOR2(K)
 7425     CONTINUE
          GOTO7440
        ENDIF
        IF(IEND.EQ.'YES')GOTO7480
        GOTO7440
C
 7440   CONTINUE
        IF(NUMDPL.LE.0)GOTO7468
        DO7465ID=1,NUMDPL
          IE2=IE2+1
          IE3=IE3+1
          IF(IE2.GT.NUME)IE2=1
C
 7450     CONTINUE
          IF(IE2.GT.1)GOTO7460
          I=I+1
C
          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7451)
 7451       FORMAT('***** FROM THE MIDDLE  OF DPSERI--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7452)IFROW,IFRMIN,IFRMAX
 7452       FORMAT('IFROW,IFRMIN,IFRMAX = ',3I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7453)I,ISUB(I),NUME
 7453       FORMAT('I,ISUB(I),NUME = ',3I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7454)MAXN,MAXCOL,MAXCP1,MAXCP2
 7454       FORMAT('MAXN,MAXCOL,MAXCP1,MAXCP2 = ',4I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7455)X0(1),X0(2),X0(3)
 7455       FORMAT('X0(1),X0(2),X0(3) = ',3E15.7)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7456)IECOL2(1),IECOL2(2),IECOL2(3)
 7456       FORMAT('IECOL2(1),IECOL2(2),IECOL2(3) = ',3I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7457)IEN(1),IEN(2),IEN(3)
 7457       FORMAT('IEN(1),IEN(2),IEN(3) = ',3I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
          IF(I.GT.MAXN)GOTO7480
          IF(ISUB(I).EQ.1)GOTO7460
          GOTO7450
C
 7460     CONTINUE
          IE=IE2
          Z0=X0(ID)
          ICOLVJ=IECOL2(IE)
          IJ=MAXN*(ICOLVJ-1)+I
          IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0
          IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0
          IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0
          IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0
          IEN(IE)=I
C
          IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
            WRITE(ICOUT,7461)IE,Z0,MAXN,ICOLVJ,I,IJ
 7461       FORMAT('IE,Z0,MAXN,ICOLVJ,I,IJ = ',I8,E15.7,I8,I8,I8,I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7462)MAXCOL,MAXCP1,MAXCP2
 7462       FORMAT('MAXCOL,MAXCP1,MAXCP2 = ',I8,I8,I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7463)IEN(IE)
 7463       FORMAT('IEN(IE) = ',I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
C
 7465   CONTINUE
        NUMVRD=IE3
        IF(NUME.LE.IE3)NUMVRD=NUME
        GOTO7469
 7468   CONTINUE
        NUMVRD=IE2-1
        GOTO7469
 7469   CONTINUE
C
 7400 CONTINUE
 7470 CONTINUE
C
      IENDTY=2
      GOTO7490
 7480 CONTINUE
      IENDTY=1
      NUMLRD=NUMLRD-1
      GOTO7490
 7490 CONTINUE
C
C               *****************************
C               **  STEP 11--              **
C               **  UPDATE THE NAME TABLE  **
C               *****************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVRD.GT.0)THEN
        DO7610IE=1,NUMVRD
          N=IEN(IE)
          ICOLVJ=IECOL2(IE)
          DO7620J=1,NUMNAM
            IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOLVJ)GOTO7625
            GOTO7620
 7625       CONTINUE
            IUSE(J)='V'
            IVALUE(J)=ICOLVJ
            IF(N.GT.IN(J))IN(J)=N
            IVSTAR(J)=MAXN*(ICOLVJ-1)+1
            IVSTOP(J)=MAXN*(ICOLVJ-1)+N
 7620     CONTINUE
 7610   CONTINUE
      ENDIF
C
      NUMVRP=NUMVRD+1
      IF(NUMVRP.LE.NUME)THEN
        DO7650IE=NUMVRP,NUME
          IEREV=NUME-IE+NUMVRP
          IF(IECASE(IEREV).EQ.'NEW')THEN
            INAM=NUMNAM
            IHNAME(INAM)='    '
            IHNAM2(INAM)='    '
            IUSE(INAM)='    '
            IVALUE(INAM)=0
            IN(INAM)=0
            NUMNAM=NUMNAM-1
            NUMCOL=NUMCOL-1
          ENDIF
 7650   CONTINUE
      ENDIF
      GOTO7900
C
 7900 CONTINUE
C
C               *************************************
C               **  STEP 12--                      **
C               **  WRITE OUT SUMMARY INFORMATION  **
C               **  ABOUT THE FILE THAT WAS READ   **
C               *************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8100)
 8100   FORMAT('INPUT DATA FILE SUMMARY INFORMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8101)IRD2
 8101   FORMAT('INPUT UNIT DEVICE NUMBER       = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8102)IFCOL3,IFCOL4
 8102   FORMAT('INPUT FILE COLUMN     LIMITS   = ',I8,4X,I8)
        CALL DPWRST('XXX','BUG ')
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
          WRITE(ICOUT,1111)IFROW2,INTINF
 1111     FORMAT('IFROW2,INTINF = ',I11,2X,I11)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(IFROW2.EQ.INTINF)THEN
          WRITE(ICOUT,8103)IFROW1
 8103     FORMAT('INPUT FILE ROW        LIMITS = ',I8,4X,'INFINITY')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8104)IFROW1,IFROW2
 8104     FORMAT('INPUT FILE ROW        LIMITS   = ',I8,4X,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,8105)ISKIP
 8105   FORMAT('NUMBER OF HEADER LINES SKIPPED = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8106)NUMLRD
 8106   FORMAT('NUMBER OF DATA   LINES READ    = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8107)NUMVRD
 8107   FORMAT('NUMBER OF VARIABLES    READ    = ',I8)
        CALL DPWRST('XXX','BUG ')
C
        IFRST=IFCOL3
        IF(IFRST+240-1.GE.IFCOL4)THEN
          ILAST=IFCOL4
        ELSE
          ILAST=IFRST+240-1
        ENDIF
C
        WRITE(ICOUT,8111)
 8111   FORMAT('THE SCANNED REGION OF THE FIRST DATA LINE READ = ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8112)(ISTOR3(J),J=IFRST,ILAST)
 8112   FORMAT(240A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8113)
 8113   FORMAT('THE SCANNED REGION OF THE LAST  DATA LINE READ = ')
        CALL DPWRST('XXX','BUG ')
        IF(IENDTY.EQ.1)THEN
          WRITE(ICOUT,8114)(ISTOR1(J),J=IFRST,ILAST)
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IENDTY.EQ.2)THEN
          WRITE(ICOUT,8114)(ISTOR2(J),J=IFRST,ILAST)
          CALL DPWRST('XXX','BUG ')
        ENDIF
 8114   FORMAT(240A1)
      ENDIF
C
C               *********************************************
C               **  STEP 13--                              **
C               **  PRINT OUT SUMMARY INFORMATION          **
C               **  ABOUT THE VARAIBLES THAT WERE READ IN  **
C               *********************************************
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8211)
 8211   FORMAT('VARIABLE     COLUMN    OBS/VARIABLE')
        CALL DPWRST('XXX','BUG ')
C
        DO8200IE=1,NUME
          IH1=JENAM1(IE)
          IH2=JENAM2(IE)
          DO8300I=1,NUMNAM
            I2=I
            IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
              WRITE(ICOUT,8311)IH1,IH2,IVALUE(I2),IN(I2)
 8311         FORMAT(A4,A4,1X,I8,5X,I8)
              CALL DPWRST('XXX','BUG ')
            ENDIF
 8300     CONTINUE
 8200   CONTINUE
      ENDIF
C
C               ***************************************
C               **  STEP 88--                        **
C               **  FOR THE FILE CASE,               **
C               **  CLOSE THE FILE.                  **
C               ***************************************
C
 8800 CONTINUE
      ISTEPN='88'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        WRITE(ICOUT,8803)IOFILE,ICURST,IREARW
 8803   FORMAT('IOFILE,ICURST,IREARW   = ',A4,A12,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IF(IOFILE.EQ.'YES'.AND.IREACS.EQ.'OPEN')THEN
        IENDFI='OFF'
        IREWIN='ON'
        IF(IREARW.EQ.'ON')THEN
          CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IENDFI,IREWIN,ISUBN0,IERRFI,
     1                IBUGS2,ISUBRO,IERROR)
          IREACS='CLOSED'
        ENDIF
      ENDIF
C
C               ******************************************
C               **  STEP 89--                           **
C               **  IF THE MACRO STATUS IS OPEN         **
C               **  THEN CHANGE IDEV FROM READ TO MACR  **
C               ******************************************
C
 8900 CONTINUE
CCCCC IF(IMACST.EQ.'OPFI')IDEV='MACR'
CCCCC IF(IMACCS.EQ.'OPEN')IDEV='MACR'
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SERI')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPSERI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFROW1,IFROW2,ICASRE
 9012   FORMAT('IFROW1,IFROW2,ICASRE = ',2I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IFCOL1,IFCOL2
 9013   FORMAT('IFCOL1,IFCOL2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ISKIP,INTINF,IBUGS2,IBUGQ
 9014   FORMAT('ISKIP,INTINF,IBUGS2,IBUGQ = ',I8,I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)IFOUND,IERROR
 9015   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)IMACRO,IMACNU,IMACCS
 9016   FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)IRD,IRD2
 9017   FORMAT('IRD,IRD2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9018)IOSW,IOFILE,IOTERM
 9018   FORMAT('IOSW,IOFILE,IOTERM = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9019)IBUGS2,ISUBRO,IERROR
 9019   FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IOUNIT
 9021   FORMAT('IOUNIT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)IFILE
 9022   FORMAT('IFILE  = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)ISTAT
 9023   FORMAT('ISTAT  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9024)IFORM
 9024   FORMAT('IFORM  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9025)IACCES
 9025   FORMAT('IACCES = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9026)IPROT
 9026   FORMAT('IPROT  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9027)ICURST
 9027   FORMAT('ICURST = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9028)IENDFI
 9028   FORMAT('IENDFI = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9029)IREWIN
 9029   FORMAT('IREWIN = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9031)ISUBN0
 9031   FORMAT('ISUBN0 = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9032)IERRFI
 9032   FORMAT('IERRFI = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9071)IREARW
 9071   FORMAT('IREARW = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPSESB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A SEASONAL SUBSERIES PLOT
C              (USED IN TIME SERIES TO IDENTIFY SEASONALITY)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/2
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION YTEMP(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),X1(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPSE'
      ISUBN2='SB  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
C
      ICOLV2=0
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SESB')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSESB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  TREAT THE SEASONAL SUBSERIES PLOT    **
C               *******************************************
C
C               *******************************************
C               **  STEP 1--                             **
C               **  SEARCH FOR SEASONAL SUBSERIES PLOT   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='SESB'
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEAS'.AND.IHARG(1).EQ.'SUBS'.AND.IHARG(2).EQ.'PLOT')
     1GOTO111
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(ICASPL.EQ.'SESB')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPSESB')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL TO    SESB')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,MIN(80,IWIDTH))
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS     **
C               **  (NLEFT) FOR THE RESPONSE VARIABLE IS POSITIVE.  **
C               ******************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPSESB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)IHLEFT,IHLEF2
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A SEASONAL SUBSERIES PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IS TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,MIN(80,IWIDTH))
 1218 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SESB')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               ***********************************************
C               **  STEP 22--                                **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EXACTLY 1                               **
C               **  FOR A SEASONAL SUBSERIES PLOT).          **
C               ***********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO2209
      GOTO2250
C
 2209 CONTINUE
      IF(NUMV2.LE.1)GOTO2290
C
 2250 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN DPSESB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR A SEASONAL SUBSERIES PLOT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST BE EXACTLY 1  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)NUMV2
 2257 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)
 2258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2259)(IANS(I),I=1,MIN(80,IWIDTH))
 2259 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
C
C               **********************************************
C               **  STEP 31--                               **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE BY                   **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='31'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO3110
      IF(ICASQ.EQ.'SUBS')GOTO3120
      IF(ICASQ.EQ.'FOR')GOTO3130
C
 3110 CONTINUE
      DO3115I=1,NLEFT
      ISUB(I)=1
 3115 CONTINUE
      NQ=NLEFT
      GOTO3150
C
 3120 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO3150
C
 3130 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO3150
C
 3150 CONTINUE
      IF(NQ.GE.MINN2)GOTO3160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** ERROR IN DPSESB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)
 3152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3153)IHLEFT,IHLEF2
 3153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3154)
 3154 FORMAT('      (FOR WHICH AN AUTO OR CROSS-PERIODOGRAM ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3155)
 3155 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3156)MINN2
 3156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3157)
 3157 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3158)
 3158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3159)(IANS(I),I=1,MIN(80,IWIDTH))
 3159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3160 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO3170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3170
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1WRITE(ICOUT,3166)I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ)
 3166 FORMAT('I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ) = ',6I8,E15.7)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL DPWRST('XXX','BUG ')
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC IF(ICOLL.EQ.MAXCP31)Y1(J)=TAGPLO(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
 3170 CONTINUE
      NS=J
C
C               ***********************************************
C               **  STEP 3.2A--                              **
C               **  CHECK FOR PARAMETER PERIOD               **
C               ***********************************************
C
      IHP='PERI'
      IHP2='OD  '
      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
        PERIOD=12.0
      ELSE
        PERIOD=VALUE(ILOCP)
      ENDIF
C
C               ***********************************************
C               **  STEP 3.2B--                              **
C               **  CHECK FOR PARAMETER START                **
C               ***********************************************
C
      IHP='STAR'
      IHP2='T   '
      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
        ISTART=1
      ELSE
        ISTART=INT(VALUE(ILOCP)+0.5)
      ENDIF
      IF(ISTART.LT.1)ISTART=1
C
C
C               *******************************************************
C               **  STEP 41--                                        **
C               **  FORM THE VERTICAL AND HORIZONTALAXIS             **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY)FOR THE   **
C               **  PLOT.  FORM THE CURVE DESIGNATION VARIABLED(.) . **
C               **  THIS WILL BE ALL ONES.                           **
C               **  DEFINE THE NUMBER OF PLOT POINTS   (NPLOTP).     **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES(NPLOTV).     **
C               *******************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SESB')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPSES2(Y1,NS,X1,YTEMP,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1PERIOD,ISTART,
     1IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SESB')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSESB--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSES2(Y1,N,X1,YTEMP,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1PERIOD,ISTART,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A SEASONAL SUBSERIES PLOT
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     CAUTION--THE INPUT VARIABLE Y1(.) WILL BE CHANGED HEREIN
C              (IT WILL BE SORTED)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/2
C     ORIGINAL VERSION--FEBRUARY  1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION X1(*)
      DIMENSION YTEMP(*)
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSE'
      ISUBN2='S2  '
C
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'SES2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSES2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO,IERROR
   52 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N,ICASPL,MAXN
   53 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y1(I)
   56 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.3)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPSES2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)
  113 FORMAT('      MUST BE AT LEAST 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,114)N
  114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      HOLD=Y1(1)
      DO120I=1,N
      IF(Y1(I).NE.HOLD)GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** ERROR IN DPSES2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,122)
  122 FORMAT('      ALL ELEMENTS IN Y1 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,123)HOLD
  123 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  129 CONTINUE
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  COMPUTE COORDINATES FOR SEASONAL SUBSERIES PLOT **
C               **  CREATE A SEASONAL INDEX VARIABLE FIRST          **
C               ******************************************************
C
C
      IPER=INT(PERIOD+0.5)
      IF(IPER.LT.1)IPER=12
C
      DO1210I=1,N
        K=I+ISTART-1
        X1(I)=MOD(K-1,IPER) + 1
 1210 CONTINUE
C
C               ******************************************************
C               **  STEP 13--                                       **
C               **  FOR EACH VALUE OF THE PERIOD, COMPUTE           **
C               **  1) THE NUMER OF ELEMENTS                        **
C               **  2) THE MEAN OF THE ELEMENTS                     **
C               ******************************************************
C
      IWRITE='OFF'
      XCOOR=0.0
      NPLOTP=0
      DO1300J=1,IPER
        NELEM=0
        DO1310I=1,N
          IF(X1(I).EQ.J)THEN
            NELEM=NELEM+1
            YTEMP(NELEM)=Y1(I)
          ENDIF
 1310   CONTINUE
        IF(NELEM.LT.1)GOTO1300
        CALL MEAN(YTEMP,NELEM,IWRITE,YMEAN,IBUGG3,IERROR) 
        DO1320L=1,NELEM
          XCOOR=XCOOR+1.0
          IF(L.EQ.1)XCSAVE=XCOOR
          NPLOTP=NPLOTP+1
          X(NPLOTP)=XCOOR
          Y(NPLOTP)=YTEMP(L)
          D(NPLOTP)=REAL(2*J-1)
 1320   CONTINUE
        NPLOTP=NPLOTP+1
        X(NPLOTP)=XCSAVE
        Y(NPLOTP)=YMEAN
        D(NPLOTP)=REAL(2*J)
        NPLOTP=NPLOTP+1
        X(NPLOTP)=XCOOR
        Y(NPLOTP)=YMEAN
        D(NPLOTP)=REAL(2*J)
        XCOOR=XCOOR+1.0
 1300 CONTINUE
C
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'SES2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSES2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO,IERROR
 9012 FORMAT('IBUGG3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,ICASPL,MAXN
 9013 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y1(I)
 9016 FORMAT('I, Y1(I), = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NPLOTP,NPLOTV
 9021 FORMAT('NPLOTP,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9022I=1,NPLOTP
      WRITE(ICOUT,9023)I,Y(I),X(I),D(I)
 9023 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSETH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXSEG,PSEGTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR A SEGMENT.
C              THE THICKNESS FOR SEGMENT I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PSEGTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFTH
C                     --MAXSEG
C     OUTPUT ARGUMENTS--PSEGTH (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              THICKNESS FOR SEGMENT I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89/2
C     ORIGINAL VERSION--JANUARY   1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFTH
      REAL        PSEGTH
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PSEGTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'THIC')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFTH
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXSEG
      PSEGTH(I)=PHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PSEGTH(I)
 1136 FORMAT('ALL SEGMENT THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPSETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE SEGMENT ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE SEGMENT IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      SEGMENT 3 THICKNESS 0.3')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXSEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSETH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE SEGMENT ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF SEGMENTS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXSEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'SEGMENT.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PSEGTH(I)=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PSEGTH(I)
 1186 FORMAT('THE THICKNESS FOR SEGMENT ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSHI3(IANS,IWIDTH,ITARWD,IANS2,IWIDT2)
C
C     NOTE--THIS SUBROUTINE IS IDENTICAL TO THE    DPSHI2   SUBROUTINE
C           AND HAS BEEN CREATED TO ACHIEVE STORAGE ECONOMY IN MAPPING.
C
C     PURPOSE--SEARCH THE VECTOR IANS(.) FOR THE
C              ITARWD-TH WORD.  FORM THE VECTOR
C              IANS2(.) WHICH IS THE SAME AS IANS(.)
C              EXCEPT ALL CHARACTERS UP TO THE BEGINNING
C              OF THE ITARWD-TH WORD HAS BEEN OMITTED.
C              THE VECTOR IANS2(.) THUS BEGINS
C              WITH THE ITARWD-TH WORD.
C     INPUT  ARGUMENTS--IANS   (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              ORIGINAL INPUT COMMAND LINE.
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE ORIGINAL COMMAND LINE.
C                     --ITARWD (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF THE WORD
C                              WHICH IS BEING SEARCHED FOR.
C     OUTPUT ARGUMENTS--IANS2  (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              SHIFTED COMMAND LINE.
C                     --IWIDT2 (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE SHIFTED COMMAND LINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 IANS2
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IANS2(*)
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
C               **********************************
C               **  STEP 1--                    **
C               **  SEARCH FOR THE FIRST BLANK  **
C               **********************************
C
      DO100I=1,IWIDTH
      I2=I
      IF(IANS(I).EQ.' ')GOTO190
  100 CONTINUE
      I2=IWIDTH+1
      GOTO190
  190 CONTINUE
C
C               *************************************
C               **  STEP 2--                       **
C               **  SEARCH FOR THE NEXT NON-BLANK  **
C               *************************************
C
      IMIN=I2+1
      IMAX=IWIDTH
      IF(IMIN.GT.IMAX)GOTO250
      DO200I=IMIN,IMAX
      I3=I
      IF(IANS(I).NE.' ')GOTO290
  200 CONTINUE
      I3=IWIDTH+1
      GOTO290
  250 CONTINUE
      I3=IWIDTH+1
      GOTO290
  290 CONTINUE
C
C               ***********************************
C               **  STEP 3--                     **
C               **  COMPUTE IANS2(.) AND IWIDT2  **
C               ***********************************
C
      J=0
      IMIN=I3
      IMAX=IWIDTH
      IF(IMIN.GT.IMAX)GOTO350
      DO300I=IMIN,IMAX
      J=J+1
      IANS2(J)=IANS(I)
  300 CONTINUE
  350 CONTINUE
      IWIDT2=J
C
  900 CONTINUE
      RETURN
      END
      SUBROUTINE DPSHPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A SHIFT PLOT
C              PLOT Y(Q) - X(Q) VERSUS X(Q)
C              WHERE X(Q) IS THE QTH QUANTILE OF X AND Y(Q)
C              IS THE CORRESPONDING QTH QUANTILE OF Y.
C              SUPPORT TWO VARIATIONS.  IF THREE VARIABLES ARE
C              SPECIFIED, THEN THE THIRD VARIABLE ARE THE QUANTILES
C              THAT ARE PLOTTED.  IF ONLY TWO VARIABLES ARE
C              SPECIFIED, THE COMPUTE THE QUANTILES CORRESPONDING
C              TO X VALUES.  THE X IS THE DATA FOR A CONTROL GROUP
C              AND Y IS THE DATA FROM AN EXPERIMENTAL GROUP.
C     REFERENCE--"INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
C                TESTING", RAND R. WILCOX, ACADEMIC PRESS, 1997.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/2
C     ORIGINAL VERSION--FEBRUARY  2003.
C
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
      CHARACTER*4 IHRI31
      CHARACTER*4 IHRI32
      CHARACTER*4 IHRI41
      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'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSH'
      ISUBN2='PL  '
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.'SHPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSHPL--')
      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 SHIFT PLOT            CASE **
C               *******************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(NUMARG.GE.1 .AND. IHARG(1).EQ.'PLOT')THEN
        ILASTC=1
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ELSE
        GOTO9000
      ENDIF
      IFOUND='YES'
      ICASPL='SHPL'
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.'SHPL')
     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.'SHPL')
     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.'SHPL')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 EITHER 2 OR 3.                  **
C               ****************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SHPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2 .OR. NUMVAR.EQ.3)GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPSHPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A SHIFT PLOT, THE NUMBER OF VARIABLES MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      BE EITHER 2 OR 3; SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      THE SPECIFIED NUMBER 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)THEN
        WRITE(ICOUT,1424)(IANS(I),I=1,MIN(IWIDTH,80))
 1424   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      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.'SHPL')
     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)
C
      IF(NUMVAR.EQ.3)THEN
        ICTAR1='THIR'
        ICTAR2='D   '
        ILOCR3=3
        IHRI31=IHARG(ILOCR3)
        IHRI32=IHARG2(ILOCR3)
        IHRIX1=IHRI31
        IHRIX2=IHRI22
        DO1530I=1,NUMNAM
          I2=I
          IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND.
     1      IUSE(I).EQ.'V')GOTO1539
          IF(IHRI31.EQ.IHNAME(I).AND.IHRI32.EQ.IHNAM2(I).AND.
     1      IUSE(I).EQ.'P')GOTO1560
 1530   CONTINUE
        GOTO1570
 1539   CONTINUE
        ILISR3=I2
        ICOLR3=IVALUE(ILISR3)
        NIRIG3=IN(ILISR3)
      ENDIF
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPSHPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2,IHRIX1,IHRIX2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST, BUT AS A')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      PARAMETER AND NOT AS A VARIABLE AS IT SHOULD BE ',
     1       '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 DPSHPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2,IHRIX1,IHRIX2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT (',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,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)THEN
        WRITE(ICOUT,1579)(IANS(I),I=1,MIN(IWIDTH,80))
 1579   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      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.'SHPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
      IF(NIRIG2.GT.NIRIG1)NLOCAL=NIRIG2
      IF(NUMVAR.EQ.3 .AND. NIRIG3.GT.NLOCAL)NLOCAL=NIRIG3
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 DPSHPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET 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,3256)
 3256 FORMAT('     (FOR WHICH A SHIFT PLOT 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)THEN
        WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **       Y3(.)                              **
C               **  CONTAINING                              **
C               **       THE EXPERMIMENTAL GROUP VARIABLE   **
C               **       THE CONTROL       GROUP VARIABLE   **
C               **       THE OPTIONAL QUANTILE   VARIABLE   **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SHPL')
     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
      IF(NUMVAR.EQ.3)THEN
        J=0
        IMAX=NIRIG3
        IF(NQ.LT.NIRIG3)IMAX=NQ
        DO3330I=1,IMAX
          IF(ISUB(I).EQ.0)GOTO3330
          J=J+1
          IJ=MAXN*(ICOLR3-1)+I
          IF(ICOLR3.LE.MAXCOL)Y3(J)=V(IJ)
          IF(ICOLR3.EQ.MAXCP1)Y3(J)=PRED(I)
          IF(ICOLR3.EQ.MAXCP2)Y3(J)=RES(I)
          IF(ICOLR3.EQ.MAXCP3)Y3(J)=YPLOT(I)
          IF(ICOLR3.EQ.MAXCP4)Y3(J)=XPLOT(I)
          IF(ICOLR3.EQ.MAXCP5)Y3(J)=X2PLOT(I)
          IF(ICOLR3.EQ.MAXCP6)Y3(J)=TAGPLO(I)
 3330   CONTINUE
        NS3=J
      ENDIF
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 3 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.'SHPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NS1.LT.MINN2)GOTO3450
      IF(NS2.LT.MINN2)GOTO3450
      IF(NUMVAR.EQ.3 .AND. NS3.LT.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPSHPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      (FOR WHICH A SHIFT PLOT IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE ',
     1       'HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)NS1,NS2,NS3
 3459 FORMAT('(NS1, NS2, NS3 = ',3I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,3461)(IANS(I),I=1,MIN(IWIDTH,80))
 3461   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      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.'SHPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPSHP2(Y1,NS1,Y2,NS2,Y3,NS3,NUMVAR,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,
     1Y4,IQUAME,IQUASE,
     1IBUGG3,ISUBRO,IERROR)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SHPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSHPL--')
      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,NIRIG3
 9015 FORMAT('NIRIG1,NIRIG2,NIRIG3 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9055)IHRI31,IHRI32
 9055 FORMAT('IHRI31,IHRI32 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)NS1,NS2,NS
 9053 FORMAT('NS1,NS2,NS3 = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSHP2(Y,NY,X,NX,Z,NZ,NUMVAR,ICASPL,MAXN,
     1Y2,X2,D2,N2,NPLOTV,
     1YTEMP,IQUAME,IQUASE,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A SHIFT PLOT.  FOR THIS,
C              PLOT Y(Q) - X(Q) VERSUS X(Q) (THAT IS, THE
C              DIFFERENCE IN THE QUANTILES VERSUS THE QUANTILES).
C              WHERE X(Q) IS THE QTH QUANTILE OF X AND Y(Q)
C              IS THE CORRESPONDING QTH QUANTILE OF Y.
C              SUPPORT TWO VARIATIONS.  IF THREE VARIABLES ARE
C              SPECIFIED, THEN THE THIRD VARIABLE ARE THE QUANTILES
C              THAT ARE PLOTTED.  IF ONLY TWO VARIABLES ARE
C              SPECIFIED, THE COMPUTE THE QUANTILES CORRESPONDING
C              TO X VALUES.  THE X IS THE DATA FOR A CONTROL GROUP
C              AND Y IS THE DATA FROM AN EXPERIMENTAL GROUP.
C              SIMILAR PURPOSE TO QUANTILE-QUANTILE OR TUKEY MEAN
C              DIFFERENCE PLOT.
C              TWO CASES:
C                 1) IF ONLY TWO VARIABLES, THEN COMPUTE THE QUANTILES
C                    AT THE X POINTS.
C                 2) IF A THIRD VARIABLE PRESENT, THESE DEFINE THE
C                    DESIRED QUANTILES.
C     REFERENCE--"INTRODUCTION TO ROBUST ESTIMATION AND HYPOTHESIS
C                TESTING", RAND R. WILCOX, ACADEMIC PRESS, 1997.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/3
C     ORIGINAL VERSION--FEBRUARY  2003.
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
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
      CHARACTER*4 IQUAM2
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Z(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION YTEMP(*)
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='DPSH'
      ISUBN2='P2  '
C
      IERROR='NO'
C
      ICASE=ICASPL
      IQUAM2=IQUAME
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SHP2')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSHP2--')
      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,NUMVAR
   53 FORMAT('ICASPL,MAXN,NX,NPLOTV,NUMVAR = ',A4,2X,I8,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
      WRITE(ICOUT,80)NZ
   80 FORMAT(' NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
      DO81I=1,NZ
      WRITE(ICOUT,72)I,Z(I)
   82 FORMAT('I,X(I) = ',I8,E12.5)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   83 CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NUMVAR.EQ.3 .AND. NZ.LE.1)GOTO1110
      IF(NY.LE.1.OR.NX.LE.1)GOTO1110
      GOTO1119
C
 1110 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPSHP2--')
      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
      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 DPSHP2--')
      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,NX
        IF(X(I).NE.HOLD)GOTO1149
 1140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPSHP2--')
      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
      IF(NUMVAR.LT.3)GOTO1199
      HOLD=Z(1)
      DO1150I=1,NZ
        IF(Z(I).NE.HOLD)GOTO1159
 1150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSHP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)HOLD
 1153 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1159 CONTINUE
C
      DO1160I=1,NZ
        IF(Z(I).LT.0.0 .OR. Z(I).GT.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1161)
 1161     FORMAT('***** ERROR IN DPSHP2--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1162)
 1162     FORMAT('      A SPECIFIED QUANTILE WAS OUTSIDE THE ALLOWABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1163)
 1163     FORMAT('      (0,1) INTERVAL.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 1160 CONTINUE
 1169 CONTINUE
C
 1199 CONTINUE
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  SORT THE INPUT VARIABLES                      **
C               ****************************************************
C
      CALL SORT(X,NX,X)
      CALL SORT(Y,NY,Y)
      IF(NUMVAR.EQ.3)CALL SORT(Z,NZ,Z)
C
C               *****************************************
C               **  STEP 22--                          **
C               **  CASE 1: THIRD VARIABLE NOT         **
C               **  SPECIFIED (SO BASE QUANTILES ON    **
C               **  THE X VARIABLE).  FOR THIS CASE,   **
C               **  Q = I/N, X(Q) = X(I).              **
C               *****************************************
C
      IWRITE='OFF'
C
      IF(NUMVAR.EQ.2)THEN
        DO2200I=1,NX
          Z(I)=REAL(I)/REAL(NX)
 2200   CONTINUE
        IF(NX.EQ.NY)THEN
          DO2210I=1,NX
            X2(I)=X(I)
            Y2(I)=Y(I) - X(I)
            D2(I)=1.0
 2210     CONTINUE
          N2=NX
        ELSE
          DO2260I=1,NX
            XQUANT=X(I)
            QNT=Z(I)
            CALL QUANT(QNT,Y,NY,IWRITE,YTEMP,MAXN,
     1                 IQUAM2,
     1                 YQUANT,IBUGG3,IERROR)
            X2(I)=X(I)
            Y2(I)=YQUANT - XQUANT
            D2(I)=1.0
 2260     CONTINUE
          N2=NX
        ENDIF
C
C               *****************************************
C               **  STEP 22--                          **
C               **  CASE 2: THIRD VARIABLE WAS         **
C               **  SPECIFIED (SO BASE QUANTILES ON    **
C               **  THIS VARIABLE).                    **
C               *****************************************
C
      ELSE
        DO2360I=1,NZ
          QNT=Z(I)
          CALL QUANT(QNT,X,NX,IWRITE,YTEMP,MAXN,
     1               IQUAM2,
     1               XQUANT,IBUGG3,IERROR)
          CALL QUANT(QNT,Y,NY,IWRITE,YTEMP,MAXN,
     1               IQUAM2,
     1               YQUANT,IBUGG3,IERROR)
          X2(I)=XQUANT
          Y2(I)=YQUANT - XQUANT
          D2(I)=1.0
 2360   CONTINUE
        N2=NZ
      ENDIF
C
      NPLOTV=3
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON' .OR. ISUBRO.EQ.'SHP2')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSHP2--')
      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
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPSIAS(ISTART,IW,NW,IHOUT,NOUT,IBUGA3,IERROR)
C
C     PURPOSE--ADD A STRING INTO IW.
C              THE STRING IS LOCATED IN IHOUT(.).
C              THE LOCATION IN IW(.) WHERE THE STRING
C              IS TO BE INSERTED IS AT ISTART.
C              THE STRING WILL BE INSERTED BETWEEN
C              LOCATIONS ISTART AND ISTART+1.
C              THE PREVIOUS CONTENTS OF LOCATIONS
C              ISTART AND LARGER WILL BE AUTOMATICALLY
C              SHIFTED TO THE RIGHT.
C              THE CONTENTS OF IW(ISTART) WILL NOT BE OVERWRITTEN.
C              THE CONTENTS OF IW(ISTART), IW(ISTART+1), ETC.
C              WILL BE DISPLACED ACCORDING TO THE LENGTH
C              OF THE INSERTED STRING.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           AND ALTERED BY THIS SUBROUTINE.
C     NOTE--IF NOUT = 0 OR NEGATIVE, THEN THE CONVENTION
C           HAS BEEN TAKEN TO LEAVE IW(.) AND NW UNCHANGED.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--FEBRUARY  1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IHOUT
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IW(*)
      DIMENSION IHOUT(*)
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
      IERROR='NO'
C
      ISHIFT=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 DPSIAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISTART,NW,NOUT
   52 FORMAT('ISTART,NW,NOUT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(IHOUT(I),I=1,MIN(NOUT,100))
   53 FORMAT('(IHOUT(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IW(I),I=1,MIN(NW,100))
   54 FORMAT('(IW(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************
C               **  STEP 1--               **
C               **  INSERT    THE STRING.  **
C               *****************************
C
      IF(NOUT.GT.0)ISHIFT=NOUT
      IF(NOUT.LE.0)ISHIFT=0
      IMIN=ISTART+1
      IMAX=NW
      IF(IMIN.GT.IMAX)GOTO150
      DO100I=IMIN,IMAX
      IPS=I+ISHIFT
      IREV=IMAX-I+IMIN
      IREVPS=IREV+ISHIFT
      IF(IREVPS.GE.IREV)IW(IREVPS)=IW(IREV)
      IF(IREVPS.LT.IREV)IW(IPS)=IW(I)
  100 CONTINUE
  150 CONTINUE
      NW=NW+ISHIFT
C
      J=ISTART
      IF(NOUT.LE.0)GOTO250
      DO200I=1,NOUT
      J=J+1
      IW(J)=IHOUT(I)
  200 CONTINUE
  250 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END        OF DPSIAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(IW(I),I=1,MIN(NW,100))
 9013 FORMAT('(IW(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIA0(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS ADDITIONS
C              (AND SUBTRACTIONS) BY 0 AND BY (0)   .
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IMIN=1
      I2=1
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 DPSIA0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.) **
C               **  FOR THE SEARCH FOR    0    .       **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR    0    .  **
C               ****************************
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.GT.NW)GOTO990
      DO200I=IMIN,NW
      I2=I
      IF(IW(I).EQ.'0   ')GOTO210
  200 CONTINUE
      GOTO990
C
  210 CONTINUE
      I=I2
      IM1=I-1
      IP1=I+1
C
C               ***********************************
C               **  STEP 3--                     **
C               **  TEST FOR THE    +0    CASE.  **
C               ***********************************
C
      IF(IM1.LT.1)GOTO390
      IF(IW(IM1).EQ.'+   ')GOTO310
      IF(IW(IM1).EQ.'-   ')GOTO310
      GOTO100
C
  310 CONTINUE
      IF(IP1.GT.NW)GOTO330
      IF(IW(IP1).EQ.'+   ')GOTO330
      IF(IW(IP1).EQ.'-   ')GOTO330
      IF(IW(IP1).EQ.')   ')GOTO320
      GOTO100
C
  320 CONTINUE
      IM2=I-2
      IF(IM2.LE.0)GOTO100
      IF(IW(IM2).EQ.'(   ')GOTO325
      GOTO330
C
  325 CONTINUE
      ISTART=IM1
      ISTOP=IM1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  330 CONTINUE
      ISTART=IM1
      ISTOP=I
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  390 CONTINUE
C
C               ***********************************
C               **  STEP 4--                     **
C               **  TEST FOR THE    0+    CASE.  **
C               ***********************************
C
      IF(IP1.GT.NW)GOTO490
      IF(IW(IP1).EQ.'+   ')GOTO410
      IF(IW(IP1).EQ.'-   ')GOTO410
      GOTO100
C
  410 CONTINUE
      IF(IM1.LT.1)GOTO420
      IF(IW(IM1).EQ.'+   ')GOTO420
      IF(IW(IM1).EQ.'-   ')GOTO420
      IF(IW(IM1).EQ.'/   ')GOTO420
      IF(IW(IM1).EQ.'(   ')GOTO420
      GOTO100
C
  420 CONTINUE
      ISTART=I
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  490 CONTINUE
C
  100 CONTINUE
C
  990 CONTINUE
C
C               *****************************************
C               **  STEP 11--                          **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.) **
C               **  FOR THE SEARCH FOR    (0)    .     **
C               *****************************************
C
      NUMPAS=1000
      DO1100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 12--             **
C               **  SEARCH FOR   (0)   .  **
C               ****************************
C
      IF(IPASS.EQ.1)IMIN=2
      IF(IPASS.GE.2)IMIN=I2+1
      NWM1=NW-1
      IF(IMIN.LT.2)GOTO1990
      IF(IMIN.GT.NWM1)GOTO1990
      DO1200I=IMIN,NWM1
      I2=I
      IM1=I-1
      IP1=I+1
      IF(IW(IM1).EQ.'(   '.AND.IW(I).EQ.'0   '.AND.
     1   IW(IP1).EQ.')   ')GOTO1210
 1200 CONTINUE
      GOTO1990
C
 1210 CONTINUE
      I=I2
      IM1=I-1
      IP1=I+1
      IM2=I-2
      IP2=I+2
C
C               ***********************************
C               **  STEP 13--                    **
C               **  TEST FOR THE   *(0)   CASE.  **
C               ***********************************
C
      IF(IM2.LT.1)GOTO1390
      IF(IW(IM2).EQ.'+   ')GOTO1310
      IF(IW(IM2).EQ.'-   ')GOTO1310
      GOTO1100
C
 1310 CONTINUE
      IF(IP2.GT.NW)GOTO1320
      IF(IW(IP2).EQ.'+   ')GOTO1320
      IF(IW(IP2).EQ.'-   ')GOTO1320
      IF(IW(IP2).EQ.')   ')GOTO1320
      GOTO1100
C
 1320 CONTINUE
      ISTART=IM2
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO1100
C
 1390 CONTINUE
C
C               ***********************************
C               **  STEP 14--                    **
C               **  TEST FOR THE   (0)*   CASE.  **
C               ***********************************
C
      IF(IP2.GT.NW)GOTO1490
      IF(IW(IP2).EQ.'+   ')GOTO1410
      IF(IW(IP2).EQ.'-   ')GOTO1410
      GOTO1100
C
 1410 CONTINUE
      IF(IM2.LT.1)GOTO1420
      IF(IW(IM2).EQ.'+   ')GOTO1420
      IF(IW(IM2).EQ.'-   ')GOTO1420
      IF(IW(IM2).EQ.'(   ')GOTO1420
      GOTO1100
C
 1420 CONTINUE
      ISTART=IM1
      ISTOP=IP2
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO1100
C
 1490 CONTINUE
C
 1100 CONTINUE
C
 1990 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 DPSIA0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIA2(IW,NW,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--SIMPLIFY AN ENTIRE EXPRESSION BY PERFORMING
C           CERTAIN SIMPLE BINARY ARITHMETIC OPERATIONS
C           INVOLVING INTEGERS AND WITHIN PARENTHESES.
C           IF INTERNAL STRING IS AN INTEGER
C           AND OF LENGTH 1
C           (OR IF INTERNAL STRING IS REDUCABLE
C           TO AN INTEGER OF LENGTH 1)
C           THEN ELIMINATE THE IMMEDIATELY PRECEDING AND
C           THE IMMMEDIATELY TRAILING PARENTHESIS.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
      IMIN=1
      IRIGHT=1
      ILEFT=1
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'SIA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,IERROR
   52 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NW
   53 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
      ISUM=0
C
C               **********************************************
C               **  STEP 3--                                **
C               **  SEARCH FOR THE NEXT RIGHT PARENTHESIS.  **
C               **********************************************
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=IRIGHT+1
      IF(IMIN.GT.NW)GOTO9000
C
      DO300I=IMIN,NW
      I2=I
      IF(IW(I).EQ.')   ')GOTO350
  300 CONTINUE
      GOTO9000
  350 CONTINUE
      IRIGHT=I2
      ISUM=ISUM+1
C
C               **********************************************
C               **  STEP 4--                                **
C               **  SEARCH FOR THE NEXT (IN REVERSE ORDER)  **
C               **  LEFT PARENTHESIS.                       **
C               **********************************************
C
      IMAX=IRIGHT-1
      IF(IMAX.LT.1)GOTO9000
C
      DO400I=1,IMAX
      IREV=IMAX-I+1
      IF(IW(IREV).EQ.'(   ')GOTO401
      IF(IW(IREV).EQ.')   ')GOTO402
      GOTO400
  401 CONTINUE
      ISUM=ISUM-1
      IF(ISUM.EQ.0)ILEFT=IREV
      IF(ISUM.EQ.0)GOTO490
      GOTO400
  402 CONTINUE
      ISUM=ISUM+1
      GOTO400
  400 CONTINUE
C
      WRITE(ICOUT,411)
  411 FORMAT('***** ERROR IN DPSIA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,412)
  412 FORMAT('      NUMBER OF LEFT PARENTHESES DOES NOT EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,413)
  413 FORMAT('      NUMBER OF RIGHT PARENTHESES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,414)
  414 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,415)(IW(I),I=1,NW)
  415 FORMAT('      ',115A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
C
C               ******************************************
C               **  STEP 5--                            **
C               **  CHECK INTERNAL STRING;              **
C               **  SIMPLIFY IF POSSIBLE.               **
C               ******************************************
C
      ISTART=ILEFT+1
      ISTOP=IRIGHT-1
      CALL DPSIS2(ISTART,ISTOP,IW,NW,IBUGA3,ISUBRO,IERROR)
C
  100 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'SIA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IERROR
 9012 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NW
 9013 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIEP(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE EXTRA PARENTHESES.
C              GIVEN THAT PARENTHESES EXIST AT LOCATIONS
C              ISTART AND ISTOP
C              (A LEFT PARENTHESIS EXISTS AT LOCATION ISTART;
C              A RIGHT PARENTHESIS EXISTS AT LOCATION ISTOP).
C              WORK OUTWARD FROM  THESE PARENTHESES
C              AND ELIMINATE REDUNDANT PAIRS OF PARENTHESES.
C     NOTE--THE PARENTHESES AT LOCATIONS
C           ISTART AND ISTOP ARE NOT THEMSELVES
C           ELIMINATED.
C     NOTE--THE 5 INPUT ARGUMENTS ARE ALL ALTERED
C           BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED--         FEBRUARY  1979.
C     UPDATED--         JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
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(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISTART,ISTOP,NW
   52 FORMAT('ISTART,ISTOP,NW = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *********************************************************
C               **  STEP 1--                                           **
C               **  DETERMINE THE NUMBER OF EXTRA SETS OF PARENTHESES  **
C               **  (NOT COUNTING THE SET AT ISTART AND ISTOP).        **
C               *********************************************************
C
      NUMEXT=0
      DO100I=1,1000
      J1=ISTART-I
      J2=ISTOP+I
      IF(J1.LT.1.OR.J1.GT.NW)GOTO190
      IF(J2.LT.1.OR.J2.GT.NW)GOTO190
      IF(IW(J1).EQ.'(   '.AND.IW(J2).EQ.')   ')GOTO150
      GOTO190
  150 CONTINUE
      NUMEXT=NUMEXT+1
  100 CONTINUE
  190 CONTINUE
C
C               ***********************************************
C               **  STEP 2--                                 **
C               **  ELIMINATE THE EXTRA SETS OF PARENTHESES  **
C               **  (LEAVING ONLY THE ORIGINAL PAIR).        **
C               ***********************************************
C
      IF(NUMEXT.LE.0)GOTO290
C
      IMIN=ISTOP+1
      IMAX=ISTOP+NUMEXT
      CALL DPSIES(IMIN,IMAX,IW,NW,IBUGA3,IERROR)
C
      IMIN=ISTART-NUMEXT
      IMAX=ISTART-1
      CALL DPSIES(IMIN,IMAX,IW,NW,IBUGA3,IERROR)
C
      ISTAR2=ISTART-NUMEXT
      IWITHI=ISTOP-ISTART-1
      ISTOP2=ISTAR2+IWITHI+1
C
      ISTART=ISTAR2
      ISTOP=ISTOP2
C
  290 CONTINUE
C
C               ******************************************
C               **  STEP 3--                            **
C               **  CHECK TO SEE IF A SINGLE PAIR (.)   **
C               **  WITH A 1-CHARACTER INTERNAL STRING  **
C               **  CAN BE COLLAPSED TO JUST            **
C               **  THE 1-CHARACTER INTERNAL STRING     **
C               **  (EXAMPLE--(X) TO X    ).            **
C               **  THIS CAN BE DONE PROVIDING THE      **
C               **  PREVIOUS WORD TO (.) IS             **
C               **  NOT A LIBRARY FUNCTION.             **
C               **         ***** CAUTION *****          **
C               **  IF SUCH A REDUCTION IS MADE,        **
C               **  ISTART AND ISTOP WILL END UP        **
C               **  WITH THE SAME VALUE                 **
C               **  AND THIS VALUE WILL BE TECHNICALLY  **
C               **  INCORRECT BECAUSE THERE WILL        **
C               **  BE NEITHER A LEFT PARENTHESES NOR A **
C               **  RIGHT PARENTHESES REMAINING AT      **
C               **  ISTART AND ISTOP--BUT RATHER        **
C               **  ONLY THE 1-CHARACTER INTERNAL       **
C               **  STRING WILL REMAIN THERE.           **
C               **  IF UNEXPLAINED PROBLEMS ARISE       **
C               **  IN SOME OF THE CALLING ROUTINES,    **
C               **  THIS TECHNICALITY MAY BE THE CAUSE  **
C               **  OF THE PROBLEM.                     **
C               ******************************************
C
      ISTAP2=ISTART+2
      IF(ISTOP.EQ.ISTAP2)GOTO410
      GOTO490
C
  410 CONTINUE
      ISTAM1=ISTART-1
      IF(ISTAM1.LE.0)GOTO450
      IF(IW(ISTAM1).EQ.'+   ')GOTO450
      IF(IW(ISTAM1).EQ.'-   ')GOTO450
      IF(IW(ISTAM1).EQ.'*   ')GOTO450
      IF(IW(ISTAM1).EQ.'/   ')GOTO450
      IF(IW(ISTAM1).EQ.'**  ')GOTO450
      IF(IW(ISTAM1).EQ.'(   ')GOTO450
      GOTO490
C
  450 CONTINUE
      IMIN=ISTOP
      IMAX=ISTOP
      CALL DPSIES(IMIN,IMAX,IW,NW,IBUGA3,IERROR)
C
      IMIN=ISTART
      IMAX=ISTART
      CALL DPSIES(IMIN,IMAX,IW,NW,IBUGA3,IERROR)
C
      ISTOP=ISTART
C
  490 CONTINUE
C
C               ****************
C               **  STEP 4--  **
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 DPSIEP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISTART,ISTOP,NW
 9012 FORMAT('ISTART,ISTOP,NW = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--SIMPLIFY AN EXPRESSION BY REMOVING
C              THE STRING STARTING WITH ISTART (INCLUSIVE)
C              THROUGH ISTOP (INCLUSIVE).
C     NOTE--THE INPUT ARGUMENTS IW(.) (FOR FIRST 4 CHARACTERS), AND
C           NW (= NUMBER OF ELEMENTS IN IW(.)
C           ARE ALTERED BY THIS SUBROUTINE.
C     NOTE--IT IS PERMISSABLE TO HAVE ISTART AND
C           ISTOP BEING THE SAME--THUS EFFECTIVELY
C           ELIMINATING A STRING OF LENGTH 1.
C     ORIGINAL VERSION--JANUARY  1979.
C     UPDATED         --JANUARY  1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
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(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISTART,ISTOP,NW
   52 FORMAT('ISTART,ISTOP,NW = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************
C               **  STEP 1--               **
C               **  ELIMINATE THE STRING.  **
C               *****************************
C
      J=ISTART-1
      IMIN=ISTOP+1
      IMAX=NW
      IF(IMIN.GT.IMAX)GOTO150
      DO100I=IMIN,IMAX
      J=J+1
      IW(J)=IW(I)
  100 CONTINUE
  150 CONTINUE
      NW=J
C
C               *****************
C               **  STEP 2--   **
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 DPSIES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIE0(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS EXPONENTIATIONS
C              BY 0.
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IW(*)
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='DPSI'
      ISUBN2='E0  '
C
      IERROR='NO'
      IMIN=1
      I2=1
      KREV=1
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 DPSIE0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR    0    .       **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR    0    .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.GE.NWP1)GOTO990
      DO200I=IMIN,NW
      I2=I
      IF(IW(I).EQ.'0   ')GOTO210
  200 CONTINUE
      GOTO990
C
  210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
      IB=IM1
      IF(IB.LE.0)GOTO100
      IF(IW(IB).EQ.'**  '.AND.IW(I).EQ.'0   ')GOTO310
      IB=IM2
      IF(IB.LE.0)GOTO100
      IF(IW(IB).EQ.'*   '.AND.IW(IM1).EQ.'*   '.AND.
     1IW(I).EQ.'0   ')GOTO310
      GOTO100
C
C               ***********************************
C               **  STEP 3--                     **
C               **  TEST FOR THE   **0    CASE.  **
C               ***********************************
C
  310 CONTINUE
      IF(IP1.GE.NWP1)GOTO320
      IF(IW(IP1).EQ.'+   ')GOTO320
      IF(IW(IP1).EQ.'-   ')GOTO320
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO320
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO320
      IF(IW(IP1).EQ.'/   ')GOTO320
      IF(IW(IP1).EQ.'(   ')GOTO320
      GOTO100
C
  320 CONTINUE
      IRIGHT=IB-1
      IF(IRIGHT.LE.0)GOTO100
      ILEFT=IRIGHT
      IF(IW(IRIGHT).EQ.')   ')GOTO333
      GOTO339
  333 CONTINUE
      ISUM=0
      DO335K=1,IRIGHT
      KREV=IRIGHT-K+1
      IF(IW(KREV).EQ.')   ')ISUM=ISUM+1
      IF(IW(KREV).EQ.'(   ')ISUM=ISUM-1
      IF(ISUM.EQ.0)GOTO337
  335 CONTINUE
      ILEFT=0
  337 CONTINUE
      ILEFT=KREV
  339 CONTINUE
C
      ISTART=ILEFT+1
      ISTOP=I
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='1   '
      GOTO100
C
  390 CONTINUE
C
  100 CONTINUE
C
  990 CONTINUE
C
C               *****************************************
C               **  STEP 11--                          **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR    (0)    .     **
C               *****************************************
C
      NUMPAS=1000
      DO1100IPASS=1,NUMPAS
C
C               ***************************
C               **  STEP 12--            **
C               **  SEARCH FOR (0)    .  **
C               ***************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.LE.0)GOTO1990
      IF(IMIN.GT.NWM1)GOTO1990
      DO1200I=IMIN,NWM1
      I2=I
      IM1=I-1
      IP1=I+1
      IF(IW(IM1).EQ.'(   '.AND.IW(I).EQ.'0   '.AND.
     1   IW(IP1).EQ.')   ')GOTO1210
 1200 CONTINUE
      GOTO1990
C
 1210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
      IB=IM2
      IF(IB.LE.0)GOTO1100
      IF(IW(IB).EQ.'**  '.AND.IW(I).EQ.'0   ')GOTO1310
      IB=IM3
      IF(IB.LE.0)GOTO1100
      IF(IW(IB).EQ.'*   '.AND.IW(IM2).EQ.'*   '.AND.
     1IW(I).EQ.'0   ')GOTO1310
      GOTO1100
C
C               ***********************************
C               **  STEP 13--                    **
C               **  TEST FOR THE  **(0)   CASE.  **
C               ***********************************
C
 1310 CONTINUE
      IF(IP2.GE.NWP1)GOTO1320
      IF(IW(IP2).EQ.'+   ')GOTO1320
      IF(IW(IP2).EQ.'-   ')GOTO1320
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1320
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1320
      IF(IW(IP2).EQ.'/   ')GOTO1320
      IF(IW(IP2).EQ.'(   ')GOTO1320
      GOTO1100
C
 1320 CONTINUE
      IRIGHT=IB-1
      IF(IRIGHT.LE.0)GOTO1100
      ILEFT=IRIGHT
      IF(IW(IRIGHT).EQ.')   ')GOTO1333
      GOTO1339
 1333 CONTINUE
      ISUM=0
      DO1335K=1,IRIGHT
      KREV=IRIGHT-K+1
      IF(IW(KREV).EQ.')   ')ISUM=ISUM+1
      IF(IW(KREV).EQ.'(   ')ISUM=ISUM-1
      IF(ISUM.EQ.0)GOTO1337
 1335 CONTINUE
      ILEFT=0
 1337 CONTINUE
      ILEFT=KREV
 1339 CONTINUE
C
      ISTART=ILEFT+1
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='1   '
      GOTO1100
C
 1390 CONTINUE
C
 1100 CONTINUE
C
 1990 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 DPSIE0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIE1(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS EXPONENTIATIONS
C              BY 1.
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IW(*)
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='DPSI'
      ISUBN2='E1  '
C
      IERROR='NO'
      IMIN=1
      I2=1
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 DPSIE1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR    1    .       **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR    1    .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.GE.NWP1)GOTO990
      DO200I=IMIN,NW
      I2=I
      IF(IW(I).EQ.'1   ')GOTO210
  200 CONTINUE
      GOTO990
C
  210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 3--                     **
C               **  TEST FOR THE   **1    CASE.  **
C               ***********************************
C
      IB=IM1
      IF(IB.LE.0)GOTO100
      IF(IW(IB).EQ.'**  '.AND.IW(I).EQ.'1   ')GOTO310
      IB=IM2
      IF(IB.LE.0)GOTO100
      IF(IW(IB).EQ.'*   '.AND.IW(IM1).EQ.'*   '.AND.
     1IW(I).EQ.'1   ')GOTO310
      GOTO100
C
  310 CONTINUE
      IF(IP1.GE.NWP1)GOTO320
      IF(IW(IP1).EQ.'+   ')GOTO320
      IF(IW(IP1).EQ.'-   ')GOTO320
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO320
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO320
      IF(IW(IP1).EQ.'/   ')GOTO320
      IF(IW(IP1).EQ.')   ')GOTO320
      GOTO100
C
  320 CONTINUE
      ISTART=IB
      ISTOP=I
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  390 CONTINUE
C
  100 CONTINUE
C
  990 CONTINUE
C
C               *****************************************
C               **  STEP 11--                          **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR    (1)    .     **
C               *****************************************
C
      NUMPAS=1000
      DO1100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 12--             **
C               **  SEARCH FOR   (1)   .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.LE.0)GOTO1990
      IF(IMIN.GT.NWM1)GOTO1990
      DO1200I=IMIN,NWM1
      I2=I
      IM1=I-1
      IP1=I+1
      IF(IW(IM1).EQ.'(   '.AND.IW(I).EQ.'1   '.AND.
     1   IW(IP1).EQ.')   ')GOTO1210
 1200 CONTINUE
      GOTO1990
C
 1210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 13--                    **
C               **  TEST FOR THE  **(1)   CASE.  **
C               ***********************************
C
      IB=IM2
      IF(IB.LE.0)GOTO1100
      IF(IW(IB).EQ.'**  '.AND.IW(I).EQ.'1   ')GOTO1310
      IB=IM3
      IF(IB.LE.0)GOTO1100
      IF(IW(IB).EQ.'*   '.AND.IW(IM2).EQ.'*   '.AND.
     1IW(I).EQ.'1   ')GOTO1310
      GOTO1100
C
 1310 CONTINUE
      IF(IP2.GE.NWP1)GOTO1320
      IF(IW(IP2).EQ.'+   ')GOTO1320
      IF(IW(IP2).EQ.'-   ')GOTO1320
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1320
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1320
      IF(IW(IP2).EQ.'/   ')GOTO1320
      IF(IW(IP2).EQ.')   ')GOTO1320
      GOTO1100
C
 1320 CONTINUE
      ISTART=IB
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO1100
C
 1390 CONTINUE
C
 1100 CONTINUE
C
 1990 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 DPSIE1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIFL(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--SIMPLIFY AN EXPRESSION BY REMOVING
C              ALL REDUNDANT PARENTHESES
C              AT THE BEGINNING AND END.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO  '
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************************
C               **  STEP 2--                          **
C               **  DETERMINE IF THE FIRST CHARACTER  **
C               **  IS A LEFT  PARENTHESIS.           **
C               **  DETERMINE IF THE LAST  CHARACTER  **
C               **  IS A RIGHT PARENTHESIS.           **
C               ****************************************
C
      IF(NW.LE.0)GOTO9000
      IF(IW(1).EQ.'(    '.AND.IW(NW).EQ.')    ')GOTO290
      GOTO9000
C
  290 CONTINUE
C
C               ***********************************************
C               **  STEP 3--                                 **
C               **  DETERMINE IF THE RIGHT PARENTHESIS       **
C               **  IN THE LAST  LOCATION IS THE COMPLEMENT  **
C               **  TO THE LEFT  PARENTHESIS                 **
C               **  IN THE FIRST LOCATION.                   **
C               ***********************************************
C
      ISUM=0
      IMIN=1
      IMAX=NW
      DO300I=IMIN,IMAX
      IF(IW(I).EQ.'(    ')GOTO301
      IF(IW(I).EQ.')    ')GOTO302
      GOTO300
  301 CONTINUE
      ISUM=ISUM-1
      ILOC0=I
      IF(ISUM.EQ.0)GOTO350
      GOTO300
  302 CONTINUE
      ISUM=ISUM+1
      ILOC0=I
      IF(ISUM.EQ.0)GOTO350
      GOTO300
  300 CONTINUE
C
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSIFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      NUMBER OF LEFT PARENTHESES DOES NOT EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      NUMBER OF RIGHT PARENTHESES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)(IW(I),I=1,NW)
  315 FORMAT('      ',115A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  350 CONTINUE
      IF(ILOC0.EQ.NW)GOTO390
      GOTO9000
  390 CONTINUE
C
C               *************************************
C               **  STEP 4--                       **
C               **  ELIMINATE THE PARENTHESES IN   **
C               **  LOCATION 1 AND LOCATION NW.    **
C               **  RESET THE VALUE IN NW.         **
C               *************************************
C
      ISTART=1
      ISTOP=1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
C
      ISTART=NW
      ISTOP=NW
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
C
  100 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 DPSIFL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIFN (X, N, KODE, M, ANS, NZ, IERR)
C***BEGIN PROLOGUE  DPSIFN
C***PURPOSE  Compute derivatives of the Psi function.
C***LIBRARY   SLATEC
C***CATEGORY  C7C
C***TYPE      DOUBLE PRECISION (PSIFN-S, DPSIFN-D)
C***KEYWORDS  DERIVATIVES OF THE GAMMA FUNCTION, POLYGAMMA FUNCTION,
C             PSI FUNCTION
C***AUTHOR  Amos, D. E., (SNLA)
C***DESCRIPTION
C
C         The following definitions are used in DPSIFN:
C
C      Definition 1
C         PSI(X) = d/dx (ln(GAMMA(X)), the first derivative of
C                  the log GAMMA function.
C      Definition 2
C                     K   K
C         PSI(K,X) = d /dx (PSI(X)), the K-th derivative of PSI(X).
C   ___________________________________________________________________
C      DPSIFN computes a sequence of SCALED derivatives of
C      the PSI function; i.e. for fixed X and M it computes
C      the M-member sequence
C
C                    ((-1)**(K+1)/GAMMA(K+1))*PSI(K,X)
C                       for K = N,...,N+M-1
C
C      where PSI(K,X) is as defined above.   For KODE=1, DPSIFN returns
C      the scaled derivatives as described.  KODE=2 is operative only
C      when K=0 and in that case DPSIFN returns -PSI(X) + LN(X).  That
C      is, the logarithmic behavior for large X is removed when KODE=2
C      and K=0.  When sums or differences of PSI functions are computed
C      the logarithmic terms can be combined analytically and computed
C      separately to help retain significant digits.
C
C         Note that CALL DPSIFN(X,0,1,1,ANS) results in
C                   ANS = -PSI(X)
C
C     Input      X is DOUBLE PRECISION
C           X      - Argument, X .gt. 0.0D0
C           N      - First member of the sequence, 0 .le. N .le. 100
C                    N=0 gives ANS(1) = -PSI(X)       for KODE=1
C                                       -PSI(X)+LN(X) for KODE=2
C           KODE   - Selection parameter
C                    KODE=1 returns scaled derivatives of the PSI
C                    function.
C                    KODE=2 returns scaled derivatives of the PSI
C                    function EXCEPT when N=0. In this case,
C                    ANS(1) = -PSI(X) + LN(X) is returned.
C           M      - Number of members of the sequence, M.ge.1
C
C    Output     ANS is DOUBLE PRECISION
C           ANS    - A vector of length at least M whose first M
C                    components contain the sequence of derivatives
C                    scaled according to KODE.
C           NZ     - Underflow flag
C                    NZ.eq.0, A normal return
C                    NZ.ne.0, Underflow, last NZ components of ANS are
C                             set to zero, ANS(M-K+1)=0.0, K=1,...,NZ
C           IERR   - Error flag
C                    IERR=0, A normal return, computation completed
C                    IERR=1, Input error,     no computation
C                    IERR=2, Overflow,        X too small or N+M-1 too
C                            large or both
C                    IERR=3, Error,           N too large. Dimensioned
C                            array TRMR(NMAX) is not large enough for N
C
C         The nominal computational accuracy is the maximum of unit
C         roundoff (=D1MACH(4)) and 1.0D-18 since critical constants
C         are given to only 18 digits.
C
C         PSIFN is the single precision version of DPSIFN.
C
C *Long Description:
C
C         The basic method of evaluation is the asymptotic expansion
C         for large X.ge.XMIN followed by backward recursion on a two
C         term recursion relation
C
C                  W(X+1) + X**(-N-1) = W(X).
C
C         This is supplemented by a series
C
C                  SUM( (X+K)**(-N-1) , K=0,1,2,... )
C
C         which converges rapidly for large N. Both XMIN and the
C         number of terms of the series are calculated from the unit
C         roundoff of the machine environment.
C
C***REFERENCES  Handbook of Mathematical Functions, National Bureau
C                 of Standards Applied Mathematics Series 55, edited
C                 by M. Abramowitz and I. A. Stegun, equations 6.3.5,
C                 6.3.18, 6.4.6, 6.4.9 and 6.4.10, pp.258-260, 1964.
C               D. E. Amos, A portable Fortran subroutine for
C                 derivatives of the Psi function, Algorithm 610, ACM
C                 Transactions on Mathematical Software 9, 4 (1983),
C                 pp. 494-502.
C***ROUTINES CALLED  D1MACH, I1MACH
C***REVISION HISTORY  (YYMMDD)
C   820601  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890911  Removed unnecessary intrinsics.  (WRB)
C   891006  Cosmetic changes to prologue.  (WRB)
C   891006  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   920501  Reformatted the REFERENCES section.  (WRB)
C***END PROLOGUE  DPSIFN
      INCLUDE 'DPCOMC.INC'
C
      INTEGER I, IERR, J, K, KODE, M, MM, MX, N, NMAX, NN, NP, NX, NZ,
     *  FN
      INTEGER I1MACH
      DOUBLE PRECISION ANS, ARG, B, DEN, ELIM, EPS, FLN,
     * FX, RLN, RXSQ, R1M4, R1M5, S, SLOPE, T, TA, TK, TOL, TOLS, TRM,
     * TRMR, TSS, TST, TT, T1, T2, WDTOL, X, XDMLN, XDMY, XINC, XLN,
     * XM, XMIN, XQ, YINT
      DIMENSION B(22), TRM(22), TRMR(100), ANS(*)
      SAVE NMAX, B
      DATA NMAX /100/
C-----------------------------------------------------------------------
C             BERNOULLI NUMBERS
C-----------------------------------------------------------------------
      DATA B(1), B(2), B(3), B(4), B(5), B(6), B(7), B(8), B(9), B(10),
     * B(11), B(12), B(13), B(14), B(15), B(16), B(17), B(18), B(19),
     * B(20), B(21), B(22) /1.00000000000000000D+00,
     * -5.00000000000000000D-01,1.66666666666666667D-01,
     * -3.33333333333333333D-02,2.38095238095238095D-02,
     * -3.33333333333333333D-02,7.57575757575757576D-02,
     * -2.53113553113553114D-01,1.16666666666666667D+00,
     * -7.09215686274509804D+00,5.49711779448621554D+01,
     * -5.29124242424242424D+02,6.19212318840579710D+03,
     * -8.65802531135531136D+04,1.42551716666666667D+06,
     * -2.72982310678160920D+07,6.01580873900642368D+08,
     * -1.51163157670921569D+10,4.29614643061166667D+11,
     * -1.37116552050883328D+13,4.88332318973593167D+14,
     * -1.92965793419400681D+16/
C
C***FIRST EXECUTABLE STATEMENT  DPSIFN
      IERR = 0
      NZ=0
      IF (X.LE.0.0D0) IERR=1
      IF (N.LT.0) IERR=1
      IF (KODE.LT.1 .OR. KODE.GT.2) IERR=1
      IF (M.LT.1) IERR=1
      IF (IERR.NE.0) RETURN
      MM=M
      NX = MIN(-I1MACH(15),I1MACH(16))
      R1M5 = D1MACH(5)
      R1M4 = D1MACH(4)*0.5D0
      WDTOL = MAX(R1M4,0.5D-18)
C-----------------------------------------------------------------------
C     ELIM = APPROXIMATE EXPONENTIAL OVER AND UNDERFLOW LIMIT
C-----------------------------------------------------------------------
      ELIM = 2.302D0*(NX*R1M5-3.0D0)
      XLN = LOG(X)
   41 CONTINUE
      NN = N + MM - 1
      FN = NN
      T = (FN+1)*XLN
C-----------------------------------------------------------------------
C     OVERFLOW AND UNDERFLOW TEST FOR SMALL AND LARGE X
C-----------------------------------------------------------------------
      IF (ABS(T).GT.ELIM) GO TO 290
      IF (X.LT.WDTOL) GO TO 260
C-----------------------------------------------------------------------
C     COMPUTE XMIN AND THE NUMBER OF TERMS OF THE SERIES, FLN+1
C-----------------------------------------------------------------------
      RLN = R1M5*I1MACH(14)
      RLN = MIN(RLN,18.06D0)
      FLN = MAX(RLN,3.0D0) - 3.0D0
      YINT = 3.50D0 + 0.40D0*FLN
      SLOPE = 0.21D0 + FLN*(0.0006038D0*FLN+0.008677D0)
      XM = YINT + SLOPE*FN
      MX = INT(XM) + 1
      XMIN = MX
      IF (N.EQ.0) GO TO 50
      XM = -2.302D0*RLN - MIN(0.0D0,XLN)
      ARG = XM/N
      ARG = MIN(0.0D0,ARG)
      EPS = EXP(ARG)
      XM = 1.0D0 - EPS
      IF (ABS(ARG).LT.1.0D-3) XM = -ARG
      FLN = X*XM/EPS
      XM = XMIN - X
      IF (XM.GT.7.0D0 .AND. FLN.LT.15.0D0) GO TO 200
   50 CONTINUE
      XDMY = X
      XDMLN = XLN
      XINC = 0.0D0
      IF (X.GE.XMIN) GO TO 60
      NX = INT(X)
      XINC = XMIN - NX
      XDMY = X + XINC
      XDMLN = LOG(XDMY)
   60 CONTINUE
C-----------------------------------------------------------------------
C     GENERATE W(N+MM-1,X) BY THE ASYMPTOTIC EXPANSION
C-----------------------------------------------------------------------
      T = FN*XDMLN
      T1 = XDMLN + XDMLN
      T2 = T + XDMLN
      TK = MAX(ABS(T),ABS(T1),ABS(T2))
      IF (TK.GT.ELIM) GO TO 380
      TSS = EXP(-T)
      TT = 0.5D0/XDMY
      T1 = TT
      TST = WDTOL*TT
      IF (NN.NE.0) T1 = TT + 1.0D0/FN
      RXSQ = 1.0D0/(XDMY*XDMY)
      TA = 0.5D0*RXSQ
      T = (FN+1)*TA
      S = T*B(3)
      IF (ABS(S).LT.TST) GO TO 80
      TK = 2.0D0
      DO 70 K=4,22
        T = T*((TK+FN+1)/(TK+1.0D0))*((TK+FN)/(TK+2.0D0))*RXSQ
        TRM(K) = T*B(K)
        IF (ABS(TRM(K)).LT.TST) GO TO 80
        S = S + TRM(K)
        TK = TK + 2.0D0
   70 CONTINUE
   80 CONTINUE
      S = (S+T1)*TSS
      IF (XINC.EQ.0.0D0) GO TO 100
C-----------------------------------------------------------------------
C     BACKWARD RECUR FROM XDMY TO X
C-----------------------------------------------------------------------
      NX = INT(XINC)
      NP = NN + 1
      IF (NX.GT.NMAX) GO TO 390
      IF (NN.EQ.0) GO TO 160
      XM = XINC - 1.0D0
      FX = X + XM
C-----------------------------------------------------------------------
C     THIS LOOP SHOULD NOT BE CHANGED. FX IS ACCURATE WHEN X IS SMALL
C-----------------------------------------------------------------------
      DO 90 I=1,NX
        TRMR(I) = FX**(-NP)
        S = S + TRMR(I)
        XM = XM - 1.0D0
        FX = X + XM
   90 CONTINUE
  100 CONTINUE
      ANS(MM) = S
      IF (FN.EQ.0) GO TO 180
C-----------------------------------------------------------------------
C     GENERATE LOWER DERIVATIVES, J.LT.N+MM-1
C-----------------------------------------------------------------------
      IF (MM.EQ.1) RETURN
      DO 150 J=2,MM
        FN = FN - 1
        TSS = TSS*XDMY
        T1 = TT
        IF (FN.NE.0) T1 = TT + 1.0D0/FN
        T = (FN+1)*TA
        S = T*B(3)
        IF (ABS(S).LT.TST) GO TO 120
        TK = 4 + FN
        DO 110 K=4,22
          TRM(K) = TRM(K)*(FN+1)/TK
          IF (ABS(TRM(K)).LT.TST) GO TO 120
          S = S + TRM(K)
          TK = TK + 2.0D0
  110   CONTINUE
  120   CONTINUE
        S = (S+T1)*TSS
        IF (XINC.EQ.0.0D0) GO TO 140
        IF (FN.EQ.0) GO TO 160
        XM = XINC - 1.0D0
        FX = X + XM
        DO 130 I=1,NX
          TRMR(I) = TRMR(I)*FX
          S = S + TRMR(I)
          XM = XM - 1.0D0
          FX = X + XM
  130   CONTINUE
  140   CONTINUE
        MX = MM - J + 1
        ANS(MX) = S
        IF (FN.EQ.0) GO TO 180
  150 CONTINUE
      RETURN
C-----------------------------------------------------------------------
C     RECURSION FOR N = 0
C-----------------------------------------------------------------------
  160 CONTINUE
      DO 170 I=1,NX
        S = S + 1.0D0/(X+NX-I)
  170 CONTINUE
  180 CONTINUE
      IF (KODE.EQ.2) GO TO 190
      ANS(1) = S - XDMLN
      RETURN
  190 CONTINUE
      IF (XDMY.EQ.X) RETURN
      XQ = XDMY/X
      ANS(1) = S - LOG(XQ)
      RETURN
C-----------------------------------------------------------------------
C     COMPUTE BY SERIES (X+K)**(-(N+1)) , K=0,1,2,...
C-----------------------------------------------------------------------
  200 CONTINUE
      NN = INT(FLN) + 1
      NP = N + 1
      T1 = (N+1)*XLN
      T = EXP(-T1)
      S = T
      DEN = X
      DO 210 I=1,NN
        DEN = DEN + 1.0D0
        TRM(I) = DEN**(-NP)
        S = S + TRM(I)
  210 CONTINUE
      ANS(1) = S
      IF (N.NE.0) GO TO 220
      IF (KODE.EQ.2) ANS(1) = S + XLN
  220 CONTINUE
      IF (MM.EQ.1) RETURN
C-----------------------------------------------------------------------
C     GENERATE HIGHER DERIVATIVES, J.GT.N
C-----------------------------------------------------------------------
      TOL = WDTOL/5.0D0
      DO 250 J=2,MM
        T = T/X
        S = T
        TOLS = T*TOL
        DEN = X
        DO 230 I=1,NN
          DEN = DEN + 1.0D0
          TRM(I) = TRM(I)/DEN
          S = S + TRM(I)
          IF (TRM(I).LT.TOLS) GO TO 240
  230   CONTINUE
  240   CONTINUE
        ANS(J) = S
  250 CONTINUE
      RETURN
C-----------------------------------------------------------------------
C     SMALL X.LT.UNIT ROUND OFF
C-----------------------------------------------------------------------
  260 CONTINUE
      ANS(1) = X**(-N-1)
      IF (MM.EQ.1) GO TO 280
      K = 1
      DO 270 I=2,MM
        ANS(K+1) = ANS(K)/X
        K = K + 1
  270 CONTINUE
  280 CONTINUE
      IF (N.NE.0) RETURN
      IF (KODE.EQ.2) ANS(1) = ANS(1) + XLN
      RETURN
  290 CONTINUE
      IF (T.GT.0.0D0) GO TO 380
      NZ=0
      IERR=2
      RETURN
  380 CONTINUE
      NZ=NZ+1
      ANS(MM)=0.0D0
      MM=MM-1
      IF (MM.EQ.0) RETURN
      GO TO 41
  390 CONTINUE
      NZ=0
      IERR=3
      RETURN
      END
      SUBROUTINE DPSIGN(XTEMP1,XTEMP2,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A SIGN TEST
C              (1-SAMPLE OR A PAIRED 2-SAMPLE)
C     EXAMPLE--SIGN TEST Y MU
C              SIGN TEST MU Y
C              SIGN TEST Y1 Y2
C              SIGN TEST Y1 Y2 D0
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/6
C     ORIGINAL VERSION--JUNE      1999.
C     UPDATED         --OCTOBER   2004. SUPPORT FOR HTML/LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ICAPSW
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      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'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSI'
      ISUBN2='GN  '
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 SIGN TEST CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'SIGN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIGN--')
      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'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS 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 DPSIGN--')
      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 SIGN 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'.OR.ISUBRO.EQ.'SIGN')
     1CALL 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 DPSIGN--')
      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 SIGN 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 23--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  THIS IS AN OPTIONAL ARGUMENT, BUT **
C               **  IF PRESENT MUST BE A NUMBER OR A  **
C               **  PARAMETER                         **
C               ****************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      D0=0.0
      IF(NUMARG.LT.3)GOTO2390
      IH31=IHARG(3)
      IH32=IHARG2(3)
      IF(IH31.EQ.'SUBS'.AND.IH32.EQ.'ET  ')GOTO2390
      IF(IH31.EQ.'FOR '.AND.IH32.EQ.'    ')GOTO2390
      IF(IH31.EQ.'EXCE'.AND.IH32.EQ.'PT  ')GOTO2390
      IF(IARGT(3).EQ.'NUMB')GOTO2310
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH31,IH32,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      D0=VALUE(ILOCV)
      GOTO2390
 2310 CONTINUE
      D0=ARG(3)
      GOTO2390
 2390 CONTINUE
C
C               *****************************************************
C               **  STEP 31--                                      **
C               **  FOR A SIGN TEST,                               **
C               **  AT LEAST ONE OF THE FIRST 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 SIGN TEST.             **
C               **  (IF SO, COPY THE OTHER ARGUMENT AS THE TARGET  **
C               **  MU VALUE).                                     **
C               **  IF BOTH ARGUMENTS ARE VARIABLES,               **
C               **  THIS IMPLIES A 2-SAMPLE SIGN TEST.             **
C               *****************************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL 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
      D0=(-999.0)
      GOTO3190
 3120 CONTINUE
      NUMVAR=1
      ILOCV=2
      AMU0=VALUE1
      D0=(-999.0)
      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 DPSIGN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3142)
 3142 FORMAT('      FOR A SIGN 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 32--                                      **
C               **  FOR A 2-SAMPLE SIGN TEST,                      **
C               **  BOTH VARIABLES MUST HAVE THE SAME NUMBER OF    **
C               **  OBSERVATIONS (I.E., PAIRED SAMPLES)            **
C               *****************************************************
C
      ISTEPN='32'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.EQ.N2.OR.NUMVAR.EQ.1)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3211)
 3211 FORMAT('***** ERROR IN DPSIGN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3212)
 3212 FORMAT('      FOR A 2-SAMPLE SIGN TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3213)
 3213 FORMAT('      BOTH VARIABLES MUST HAVE THE SAME NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3218)
 3218 FORMAT('      OBSERVATIONS.  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3220)IH11,IH12,N1
 3220 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3222)IH21,IH22,N2
 3222 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3239)
 3239 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3250)(IANS(I),I=1,IWIDTH)
 3250 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
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'.AND.ISUBRO.NE.'SIGN')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'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPSIGN--')
      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 SIGN 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'.OR.ISUBRO.EQ.'SIGN')
     1CALL 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 DPSIGN--')
      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 SIGN 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
      IF(NS1.EQ.NS2.OR.NUMVAR.LT.2)GOTO4390
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4351)
 4351 FORMAT('***** ERROR IN DPSIGN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4352)
 4352 FORMAT('      AFTER THE APPROPRIATE SUBSETS HAVE BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4353)
 4353 FORMAT('      THE NUMBER OF OBSERVATIONS FROM THE TWO ',
     1'VARIABLES ARE NOT EQUAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4354)IH11,IH12,NS1
 4354 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4355)IH21,IH22,NS2
 4355 FORMAT('      VARIABLE ',A4,A4,' HAS ',I8,' OBSERVATIONS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4358)
 4358 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4359)(IANS(I),I=1,IWIDTH)
 4359 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4390 CONTINUE
C
C               *********************************
C               **  STEP 52--                  **
C               **  CARRY OUT  THE SIGN TEST   **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'SIGN')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPSIGN, AS WE ARE ABOUT TO CALL DPSIG2--')
      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
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPSIG2(Y,NS1,X,NS2,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP1,XTEMP2,MAXNXT,
     1STATV1,STATV2,STATC1,STATC2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ICAPTY,ICAPSW,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPSI'
C
      IH='STAT'
      IH2='VALP'
      VALUE0=STATV1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='VALM'
      VALUE0=STATV2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDFP'
      VALUE0=STATC1
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDFM'
      VALUE0=STATC2
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW90'
      VALUE0=CUTL90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW95'
      VALUE0=CUTL95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTL'
      IH2='OW99'
      VALUE0=CUTL99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
 
C               *****************
C               **  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 DPSIGN--')
      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 DPSIG2(Y1,N1,Y2,N2,AMU0,D0,NUMVAR,ILOCV,
     1XTEMP1,XTEMP2,MAXNXT,
     1STATV1,STATV2,STATC1,STATC2,
     1CUTL90,CUTU90,CUTL95,CUTU95,CUTL99,CUTU99,
     1ICAPTY,ICAPSW,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A SIGN TEST
C              (1-SAMPLE OR 2-SAMPLE)
C     EXAMPLE--SIGN TEST Y MU
C              SIGN TEST MU Y
C              SIGN TEST Y1 Y2
C              SIGN TEST Y1 Y2 D0
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              (BUT N1 SHOULD EQUAL N2)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/6
C     ORIGINAL VERSION--JUNE      1999.
C     UPDATED         --AUGUST    2000. BIG FIX FOR ICONC2
C     UPDATED         --AUGUST    2002. MODIFY OUTPUT FOR BETTER
C                                       CLARITY
C     UPDATED         --OCTOBER   2004. SUPPORT FOR HTML/LATEX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPTY
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBASLC
C
      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='DPSI'
      ISUBN2='G2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIGN')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPSIG2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,53)NUMVAR,ILOCV
   53   FORMAT('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),Y2(I)
   57     FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','WRIT')
   56   CONTINUE
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN SIGN TEST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE VARIABLES ',
     1         'IS NON-POSITIVE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)N1
 1113   FORMAT('SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(N1.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1121)
 1121   FORMAT('***** NOTE FROM SIGN TEST--VARIABLE 1 ',
     1         'HAS ONLY 1 ELEMENT')
        CALL DPWRST('XXX','WRIT')
        GOTO9000
      ENDIF
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 SIGN TEST--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(NUMVAR.LT.2)GOTO1239
      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 SIGN TEST--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 SIGN TEST OR        **
C               **   2-SAMPLE SIGN TEST.          **
C               ************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL 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 SIGN TEST   **
C               *********************************
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      NTEMP=0
      RMINUS=0.0
      RPLUS=0.0
      DO3200I=1,N1
        ADIFF=Y1(I) - AMU0
        IF(ADIFF.LT.0.0)THEN
          NTEMP=NTEMP+1
          RMINUS=RMINUS+1.0
        ELSEIF(ADIFF.GT.0.0)THEN
          NTEMP=NTEMP+1
          RPLUS=RPLUS+1.0
        ENDIF
 3200 CONTINUE
      CALL BINCDF(RMINUS,0.5,NTEMP,RMCDF)
      CALL BINCDF(RPLUS,0.5,NTEMP,RPCDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
CCCCC AUGUST 2002.  FIX FOLLOWING LINES.
CCCCC IF(RPCDF.GT.0.05)ICONC1='ACCEPT'
CCCCC IF(RPCDF.GT.0.05 .AND. RPCDF.LT.0.950)ICONC2='ACCEPT'
CCCCC IF(RPCDF.GT.0.05 .AND. RPCDF.LT.0.950)ICONC2='ACCEPT'
CCCCC IF(RMCDF.GT.0.05)ICONC3='ACCEPT'
      IF(RPCDF.LE.0.05)ICONC1='ACCEPT'
      IF(RMCDF.LE.0.05)ICONC3='ACCEPT'
      IF(RPCDF.LE.0.025 .OR. RMCDF.LE.0.025)ICONC2='ACCEPT'
C
      STATV1=RPLUS
      STATV2=RMINUS
      STATC1=RPCDF
      STATC2=RMCDF
      CALL BINPPF(.050,0.5,NTEMP,CUTL90)
      CALL BINPPF(.950,0.5,NTEMP,CUTU90)
      CALL BINPPF(.025,0.5,NTEMP,CUTL95)
      CALL BINPPF(.975,0.5,NTEMP,CUTU95)
      CALL BINPPF(.005,0.5,NTEMP,CUTL99)
      CALL BINPPF(.995,0.5,NTEMP,CUTU99)
C
C               *********************************
C               **   STEP 32--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR A 2-SAMPLE SIGN TEST  **
C               *********************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5001   FORMAT('</PRE>')
        WRITE(ICOUT,5001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5011   FORMAT('<UL>')
 5013   FORMAT('<TABLE NOBORDER>')
 5015   FORMAT('   <CAPTION ALIGN=CENTER>')
 5017   FORMAT('      <B>ONE SAMPLE SIGN TEST</B>')
 5019   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5013)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5015)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5017)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5019)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5041   FORMAT('   <TR>')
 5043   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=250>')
 5047   FORMAT('      </TD>')
 5048   FORMAT('      <TD ALIGN=CENTER VALIGN=TOP WIDTH=50>')
 5049   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=150>')
 5051   FORMAT('         ',G15.7)
 5052   FORMAT('         ',I8)
 5055   FORMAT('         ',A8)
 5059   FORMAT('   </TR>')
 5060   FORMAT('         =')
 5057   FORMAT('         &nbsp;')
 5058   FORMAT('         &ne;')
 5061   FORMAT('         H<sub>0</sub>: Median ')
 5062   FORMAT('         H<sub>a</sub>: Median ')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5058)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5071   FORMAT('         <B>Sample:</B>')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5071)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5057)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5072   FORMAT('         Number of Observations')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5072)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)N1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5073   FORMAT('         Number of Positive Differences')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5073)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)INT(RPLUS+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5074   FORMAT('         Number of Negative Differences')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5074)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5052)INT(RMINUS+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5075   FORMAT('         Sign Test Statistic CDF Value (R+)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5075)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)RPCDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
 5076   FORMAT('         Sign Test Statistic CDF Value (R-)')
        WRITE(ICOUT,5041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5076)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5048)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5060)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5051)RMCDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5059)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5091   FORMAT('</TABLE>')
 5093   FORMAT('</UL>')
 5094   FORMAT('<P>')
        WRITE(ICOUT,5091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5094)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5111   FORMAT('<UL>')
 5113   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TH ALIGN=CENTER VALIGN=TOP WIDTH=200>')
 5127   FORMAT('      </TH>')
 5139   FORMAT('   </TR>')
 5161   FORMAT('      <TD COLSPAN=3>')
 5162   FORMAT('          <HR>')
 5171   FORMAT('         Alternative-<BR>Hypothesis')
 5172   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Acceptance Interval')
 5173   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Conclusion')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5172)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5241   FORMAT('   <TR>')
 5243   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM>')
 5247   FORMAT('      </TD>')
 5259   FORMAT('   </TR>')
 5261   FORMAT('         Median &ne; ',G12.7)
 5262   FORMAT('         R+: (0,0.25), R-: (0,0.025)')
 5263   FORMAT('         ',A6)
 5271   FORMAT('         Median < ',G12.7)
 5272   FORMAT('         R+: (0,0.05)')
 5281   FORMAT('         Median > ',G12.7)
 5282   FORMAT('         R-: (0,0.05)')
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5261)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5271)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5272)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5281)AMU0
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5282)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5263)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5259)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
 5194   FORMAT('<PRE>')
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5194)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8001 FORMAT(A1,'end{verbatim}')
 8003 FORMAT(A1,'begin{table}')
 8007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8009 FORMAT(A1,'begin{center}')
 8011 FORMAT(5X,'{',A1,'bf ONE SAMPLE SIGN TEST}')
 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$ Median & = & ',
     1       G15.7,2X,A1,A1)
 8022 FORMAT(5X,'$H_a$ Median ($',A1,'ne$) & ',
     1       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,'Number of Positive Differences & = & ',I8,2X,A1,A1)
 8027 FORMAT(5X,'Number of Negative Differences & = & ',I8,2X,A1,A1)
 8028 FORMAT(5X,'Sign Test Statistic CDF Value (R+) & = & ',
     1       G15.7,2X,A1,A1)
 8029 FORMAT(5X,'Sign Test Statistic CDF Value (R-) & = & ',
     1       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)AMU0,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)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)N1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)INT(RPLUS+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)INT(RMINUS+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)RPCDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)RMCDF,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,'Median $',A1,'ne$ ',G15.7,' & (0,0.5) & ',
     1       ' & (0,0.025), (0.975,1) & ',
     1       A6,2X,A1,A1)
 8125 FORMAT(5X,'Median < ',G15.7,' & (0,0.5) & ',A6,2X,A1,A1)
 8126 FORMAT(5X,'Median > ',G15.7,' & (0,0.5) & ',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,AMU0,ICONC1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8125)AMU0,ICONC2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8126)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 SIGN TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3213)AMU0
 3213   FORMAT('H0: POPULATION MEDIAN = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3221)N1
 3221   FORMAT('SAMPLE SIZE                        = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3223)INT(RPLUS+0.5)
 3223   FORMAT('NUMBER OF POSITIVE DIFFERENCES     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3225)INT(RMINUS+0.5)
 3225   FORMAT('NUMBER OF NEGATIVE DIFFERENCES     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3227)RPCDF
 3227   FORMAT('SIGN TEST STATISTIC CDF VALUE (R+) = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3229)RMCDF
 3229   FORMAT('SIGN TEST STATISTIC CDF VALUE (R-) = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3258)
 3258   FORMAT(12X,
     1  '               ALTERNATIVE-                    ALTERNATIVE-')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3259)
 3259   FORMAT(
     1  'ALTERNATIVE-   ',12X,
     1  'HYPOTHESIS                     HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3261)
 3261   FORMAT(
     1  'HYPOTHESIS     ',12X,
     1  'ACCEPTANCE INTERVAL            CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3263)AMU0,ICONC2
 3263   FORMAT(
     1  'MEDIAN <> ',G15.7,
     1  '  R+: (0,0.025), R-: (0,0.025)   ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3262)AMU0,ICONC1
 3262   FORMAT(
     1  'MU1 <     ',G15.7,
     1  '  (R+) (0,0.05)                  ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3264)AMU0,ICONC3
 3264   FORMAT(
     1  'MU1 >     ',G15.7,
     1  '  (R-) (0,0.05)                  ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 3290   CONTINUE
      ENDIF
      ENDIF
C
      GOTO9000
C
C
C               *********************************
C               **  STEP 41--                  **
C               **  CARRY OUT CALCULATIONS     **
C               **  FOR A 2-SAMPLE SIGN TEST   **
C               *********************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
C
      NTEMP=0
      RMINUS=0.0
      RPLUS=0.0
      DO4200I=1,N1
        ADIFF=Y1(I) - Y2(I) - D0
        IF(ADIFF.LT.0.0)THEN
          NTEMP=NTEMP+1
          RMINUS=RMINUS+1.0
        ELSEIF(ADIFF.GT.0.0)THEN
          NTEMP=NTEMP+1
          RPLUS=RPLUS+1.0
        ENDIF
 4200 CONTINUE
      CALL BINCDF(RMINUS,0.5,NTEMP,RMCDF)
      CALL BINCDF(RPLUS,0.5,NTEMP,RPCDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
CCCCC AUGUST 2002.  FIX FOLLOWING LINES
CCCCC IF(RPCDF.GT.0.05)ICONC1='ACCEPT'
CCCCC IF(RPCDF.GT.0.05 .AND. RPCDF.LT.0.950)ICONC2='ACCEPT'
CCCCC IF(RPCDF.GT.0.025 .AND. RPCDF.LT.0.975)ICONC2='ACCEPT'
CCCCC IF(RMCDF.GT.0.05)ICONC3='ACCEPT'
C
      IF(RPCDF.LE.0.05)ICONC1='ACCEPT'
      IF(RMCDF.LE.0.05)ICONC3='ACCEPT'
      IF(RPCDF.LE.0.025 .OR. RMCDF.LE.0.025)ICONC2='ACCEPT'
C
      STATV1=RPLUS
      STATV2=RMINUS
      STATC1=RPCDF
      STATC2=RMCDF
      CALL BINPPF(.050,0.5,NTEMP,CUTL90)
      CALL BINPPF(.950,0.5,NTEMP,CUTU90)
      CALL BINPPF(.025,0.5,NTEMP,CUTL95)
      CALL BINPPF(.975,0.5,NTEMP,CUTU95)
      CALL BINPPF(.005,0.5,NTEMP,CUTL99)
      CALL BINPPF(.995,0.5,NTEMP,CUTU99)
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR A 2-SAMPLE SIGN TEST  **
C               *********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'SIG2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON'.AND.ICAPTY.EQ.'HTML')THEN
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
 5501   FORMAT('</PRE>')
        WRITE(ICOUT,5501)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5511   FORMAT('<UL>')
 5513   FORMAT('<TABLE NOBORDER>')
 5515   FORMAT('   <CAPTION ALIGN=CENTER>')
 5517   FORMAT('      <B>TWO SAMPLE (PAIRED) SIGN TEST</B>')
 5519   FORMAT('   </CAPTION>')
        WRITE(ICOUT,5511)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5513)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5515)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5517)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5519)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5541   FORMAT('   <TR>')
 5543   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=250>')
 5547   FORMAT('      </TD>')
 5548   FORMAT('      <TD ALIGN=CENTER VALIGN=TOP WIDTH=50>')
 5549   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=150>')
 5551   FORMAT('         ',G15.7)
 5552   FORMAT('         ',I8)
 5555   FORMAT('         ',A8)
 5559   FORMAT('   </TR>')
 5560   FORMAT('         =')
 5557   FORMAT('         &nbsp;')
 5558   FORMAT('         &ne;')
 5561   FORMAT('         H<sub>0</sub>: Median<sub>1</sub>')
 5562   FORMAT('         H<sub>a</sub>: Median<sub>1</sub>')
 5563   FORMAT('         Median<sub>2</sub>')
 5567   FORMAT('         H<sub>0</sub>: Median<sub>1</sub> - ',
     1         'Median<sub>2</sub>')
 5568   FORMAT('         H<sub>a</sub>: Median<sub>1</sub> - ',
     1         'Median<sub>2</sub>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5561)
        ELSE
          WRITE(ICOUT,5567)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5563)
        ELSE
          WRITE(ICOUT,5551)D0
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5562)
        ELSE
          WRITE(ICOUT,5568)
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5558)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5563)
        ELSE
          WRITE(ICOUT,5551)D0
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5571   FORMAT('         <B>Sample:</B>')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5571)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5557)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5572   FORMAT('         Number of Observations')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5572)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5552)N1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5573   FORMAT('         Number of Positive Differences')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5573)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5552)INT(RPLUS+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5574   FORMAT('         Number of Negative Differences')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5574)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5552)INT(RMINUS+0.5)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5575   FORMAT('         Sign Test Statistic CDF Value (R+)')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5575)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5551)RPCDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
 5576   FORMAT('         Sign Test Statistic CDF Value (R-)')
        WRITE(ICOUT,5541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5576)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5548)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5560)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5551)RMCDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5559)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5591   FORMAT('</TABLE>')
 5593   FORMAT('</UL>')
 5594   FORMAT('<P>')
        WRITE(ICOUT,5591)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5593)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5594)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 5611   FORMAT('<UL>')
 5613   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,5611)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5613)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
 5621   FORMAT('   <TR>')
 5623   FORMAT('      <TH ALIGN=CENTER VALIGN=TOP WIDTH=200>')
 5627   FORMAT('      </TH>')
 5639   FORMAT('   </TR>')
 5661   FORMAT('      <TD COLSPAN=3>')
 5662   FORMAT('          <HR>')
 5671   FORMAT('         Alternative-<BR>Hypothesis')
 5672   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Acceptance Interval')
 5673   FORMAT('         Alternative-<BR>Hypothesis<BR>',
     1         'Conclusion')
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5671)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5672)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5623)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5673)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5627)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,5621)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5661)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5662)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5639)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
 5741   FORMAT('   <TR>')
 5743   FORMAT('      <TD ALIGN=CENTER VALIGN=BOTTOM>')
 5747   FORMAT('      </TD>')
 5759   FORMAT('   </TR>')
 5761   FORMAT('         Median<sub>1</sub> &ne; Median<sub>2</sub>')
 5766   FORMAT('         Median<sub>1</sub> - Median<sub>2</sub> ',
     1         '&ne; ',G12.7)
 5762   FORMAT('         R+: (0,0.25), R-: (0,0.025')
 5763   FORMAT('         ',A6)
 5771   FORMAT('         Median<sub>1</sub> < Meidan<sub>2</sub>')
 5776   FORMAT('         Median<sub>1</sub> - Median<sub>2</sub> < ',
     1                   G12.7)
 5772   FORMAT('         R+: (0,0.05)')
 5781   FORMAT('         Median<sub>1</sub> > Meidan<sub>2</sub>')
 5786   FORMAT('         Median<sub>1</sub> - Median<sub>2</sub> > ',
     1                   G12.7)
 5782   FORMAT('         R-: (0,0.05)')
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5761)
        ELSE
          WRITE(ICOUT,5766)D0
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5762)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5763)ICONC1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5771)
        ELSE
          WRITE(ICOUT,5776)D0
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5772)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5763)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5741)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,5781)
        ELSE
          WRITE(ICOUT,5786)D0
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5782)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5743)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5763)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5747)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5759)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
 5691   FORMAT('</TABLE>')
 5693   FORMAT('</UL>')
 5694   FORMAT('<PRE>')
        WRITE(ICOUT,5691)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5693)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5694)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
 8501 FORMAT(A1,'end{verbatim}')
 8503 FORMAT(A1,'begin{table}')
 8507 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8509 FORMAT(A1,'begin{center}')
 8511 FORMAT(5X,'{',A1,'bf TWO SAMPLE (PAIRED) SIGN TEST}')
 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$: $Median_1$ & = & $Median_2$ ',
     1       2X,A1,A1)
88521 FORMAT(5X,'$H_0$: $Median_1$ - $Median_2$ & eq & ',
     1       G15.7,2X,A1,A1)
 8522 FORMAT(5X,'$H_a$: $Median_1$ & ',A1,'ne & $Median_2$ ',
     1       2X,A1,A1)
88522 FORMAT(5X,'$H_a$: $Median_1$ - $Median_2$ & ',A1,'ne & ',
     1       G15.7,2X,A1,A1)
 8523 FORMAT(5X,' &   & ',2X,A1,A1)
 8524 FORMAT(5X,'{',A1,'bf Sample:} &   & ',2X,A1,A1)
 8525 FORMAT(5X,'Number of Observations & = & ',I8,2X,A1,A1)
 8526 FORMAT(5X,'Number of Positive Differences & = & ',I8,2X,A1,A1)
 8527 FORMAT(5X,'Number of Negative Differences & = & ',I8,2X,A1,A1)
 8528 FORMAT(5X,'Sign Test Statistic CDF Value (R+) & = & ',
     1       G15.7,2X,A1,A1)
 8529 FORMAT(5X,'Sign Test Statistic CDF Value (R-) & = & ',
     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')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,8521)IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,88521)D0,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,8522)IBASLC,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,88522)IBASLC,D0,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        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)INT(RPLUS+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8527)INT(RMINUS+0.5),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8528)RPCDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8529)RMCDF,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}',2X,A1,A1)
 8622 FORMAT(5X,'{',A1,'bf Alternative} & {',A1,
     1       'bf Hypothesis} & {',A1,'bf Hypothesis}',
     1       2X,A1,A1)
 8623 FORMAT(5X,'{',A1,'bf Hypothesis} & {',A1,
     1       'bf Acceptance Interval} & {',A1,
     1       'bf Conclusion}',2X,A1,A1)
 8624 FORMAT(5X,'$Median_1 ',A1,'ne Median_2$ ',' & (0,0.5) & ',
     1       ' & (0,0.025), (0.975,1) & ',
     1       A6,2X,A1,A1)
88624 FORMAT(5X,'$Median_1 - Median_2 ',A1,'ne $ ',G15.7,
     1       ' & (0,0.5) & ',
     1       ' & (0,0.025), (0.975,1) & ',
     1       A6,2X,A1,A1)
 8625 FORMAT(5X,'$Median_1$ < $Median_2$ & (0,0.5) & ',A6,2X,A1,A1)
88625 FORMAT(5X,'$Median_1$ - $Median_2$ < ',G15.7,
     1       ' & (0,0.5) & ',A6,2X,A1,A1)
 8626 FORMAT(5X,'$Median_1$ > $Median_2$ & (0,0.5) & ',A6,2X,A1,A1)
88626 FORMAT(5X,'$Median_1$ - $Median_2$ > ',G15.7,
     1       ' & (0,0.5) & ',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
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8622)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8623)IBASLC,IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8640)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,8624)IBASLC,ICONC1,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,88624)IBASLC,D0,ICONC1,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,8625)ICONC1,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,88625)D0,ICONC1,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,8626)ICONC1,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,88626)D0,ICONC1,IBASLC,IBASLC
        ENDIF
        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(
     1  '           TWO SAMPLE (PAIRED) SIGN TEST')
        CALL DPWRST('XXX','WRIT')
        IF(D0.EQ.0.0)THEN
          WRITE(ICOUT,4213)
 4213     FORMAT('H0: TWO POPULATION MEDIANS ARE EQUAL')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4215)D0
 4215     FORMAT('H0: THE DIFFERENCE OF TWO POPULATION MEDIANS = ',
     1           G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,4221)N1
 4221   FORMAT('SAMPLE SIZE                        = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4223)INT(RPLUS+0.5)
 4223   FORMAT('NUMBER OF POSITIVE DIFFERENCES     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4225)INT(RMINUS+0.5)
 4225   FORMAT('NUMBER OF NEGATIVE DIFFERENCES     = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4227)RPCDF
 4227   FORMAT('SIGN TEST STATISTIC CDF VALUE (R+) = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4229)RMCDF
 4229   FORMAT('SIGN TEST STATISTIC CDF VALUE (R-) = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4258)
 4258   FORMAT(8X,
     1'               ALTERNATIVE-                   ALTERNATIVE-')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4259)
 4259   FORMAT(
     1  'ALTERNATIVE-',11X,
     1  'HYPOTHESIS                     HYPOTHESIS')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4261)
 4261   FORMAT(
     1  'HYPOTHESIS',13X,
     1  'ACCEPTANCE INTERVAL            CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4263)ICONC2
 4263   FORMAT(
     1  'MEDIAN1 <> MEDIAN2     R+: (0,0.025), R-: (0,0.025)   ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4262)ICONC1
 4262   FORMAT(
     1  'MEDIAN1 < MEDIAN2      (R+) (0,0.05)                  ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4264)ICONC3
 4264   FORMAT(
     1  'MEIDAN1 > MEDIAN2      (R-) (0,0.05)                  ',A6)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
 4290   CONTINUE
      ENDIF
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'SIGN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIG2--')
      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,D0,NUMVAR,ILOCV
 9013 FORMAT('AMU0,D0,NUMVAR,ILOCV = ',2E15.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 DPSIIS(ISTART,IW,NW,IHOUT,NOUT,IBUGA3,IERROR)
C
C     PURPOSE--INSERT A STRING INTO IW.
C              THE STRING IS LOCATED IN IHOUT(.).
C              THE LOCATION IN IW(.) WHERE THE STRING
C              IS TO BE INSERTED IS AT ISTART.
C              THE CONTENTS OF IW(ISTART) WILL BE OVERWRITTEN.
C              THE CONTENTS OF IW(ISTART+1), IW(ISTART+2), ETC.
C              WILL BE DISPLACED ACCORDING TO THE LENGTH
C              OF THE INSERTED STRING.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           AND ALTERED BY THIS SUBROUTINE.
C     NOTE--IF NOUT = 0 OR NEGATIVE, THEN THE CONVENTION
C           HAS BEEN TAKEN TO SHIFT THE REMAINING
C           STRING IN IW(.) STARTING AT ISTART+1
C           OVER 1 LOCATION SO THAT IT WOULD THEN
C           START AT ISTART.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IHOUT
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IW(*)
      DIMENSION IHOUT(*)
C
C-----COMMON VARIABLES (GENERAL)-----------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSI'
      ISUBN2='IS  '
C
      IERROR='NO'
C
      ISHIFT=(-999)
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)
   81 FORMAT('***** AT THE BEGINNING OF DPSIIS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)ISTART,NW,NOUT
   82 FORMAT('ISTART,NW,NOUT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)(IHOUT(I),I=1,NOUT)
   83 FORMAT('(IHOUT(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)(IW(I),I=1,NW)
   84 FORMAT('(IW(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************
C               **  STEP 1--               **
C               **  INSERT    THE STRING.  **
C               *****************************
C
      IF(NOUT.GE.0)ISHIFT=NOUT-1
      IF(NOUT.LT.0)ISHIFT=(-1)
      IMIN=ISTART+1
      IMAX=NW
      IF(IMIN.GT.IMAX)GOTO150
      DO100I=IMIN,IMAX
      IPS=I+ISHIFT
      IREV=IMAX-I+IMIN
      IREVPS=IREV+ISHIFT
      IF(IREVPS.GE.IREV)IW(IREVPS)=IW(IREV)
      IF(IREVPS.LT.IREV)IW(IPS)=IW(I)
  100 CONTINUE
  150 CONTINUE
      NW=NW+ISHIFT
C
      J=ISTART-1
      IF(NOUT.LE.0)GOTO250
      DO200I=1,NOUT
      J=J+1
      IW(J)=IHOUT(I)
  200 CONTINUE
  250 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIIS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(IW(I),I=1,NW)
 9013 FORMAT('(IW(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSING(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PREICSION SWITCH
C              AS SINGLE PRECISION.
C              THIS IN TURN SPECIFIES THAT SUBSEQUENT
C              CALCULATIONS WILL ALL BE CARRIED OUT
C              IN SINGLE PRECISION.
C              THE SPECIFIED PRECISION SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IPREC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFPR (A  HOLLERITH VARIABLE)
C                     --IHMXPR (A  HOLLERITH VARIABLE)
C     OUTPUT ARGUMENTS--IPREC  (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPR
      CHARACTER*4 IHMXPR
      CHARACTER*4 IPREC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1130
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1130
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      GOTO1130
C
 1120 CONTINUE
      IHOLD=IDEFPR
      GOTO1160
C
 1130 CONTINUE
      IHOLD='SING'
      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 DPSING--')
      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 DPSIP0(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS MULTIPLICATIONS
C              (BUT NOT DIVISIONS) BY 0 AND BY (0)   .
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IFOUND
C
      DIMENSION IW(*)
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='DPSI'
      ISUBN2='P0  '
C
      IERROR='NO'
      IMIN=1
      I2=1
      IM1=1
      IP1=1
      KREV=1
      K2=1
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 DPSIP0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR    1    .       **
C               *****************************************
C
      IFOUND='NO'
      NUMPAS=1000
      DO1100IPASS=1,NUMPAS
      ISTEPN='1100'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR    0    .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2.AND.IFOUND.EQ.'YES')IMIN=I2
      IF(IPASS.GE.2.AND.IFOUND.EQ.'NO')IMIN=I2+1
      IFOUND='NO'
      IF(IMIN.GE.NWP1)GOTO1990
      DO200I=IMIN,NW
      I2=I
      IF(IW(I).EQ.'0   ')GOTO210
  200 CONTINUE
      GOTO990
C
  210 CONTINUE
      ISTEPN='210'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 3--                     **
C               **  TEST FOR THE    *0    CASE.  **
C               ***********************************
C
      IF(IM1.LE.0)GOTO390
      IF(IM1.EQ.1.AND.IW(IM1).EQ.'*   ')GOTO310
      IF(IM1.GE.2.AND.IW(IM1).EQ.'*   '.AND.IW(IM2).NE.'*   ')GOTO310
CCCCC IF(IW(IM1).EQ.'/   ')GOTO310
      GOTO100
C
  310 CONTINUE
      ISTEPN='310'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IP1.GE.NWP1)GOTO320
      IF(IW(IP1).EQ.'+   ')GOTO320
      IF(IW(IP1).EQ.'-   ')GOTO320
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO320
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO320
      IF(IW(IP1).EQ.'/   ')GOTO320
      IF(IW(IP1).EQ.')   ')GOTO320
      GOTO100
C
  320 CONTINUE
      ISTEPN='320'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IB=IM1
      IRIGHT=IB-1
      IF(IRIGHT.LE.0)GOTO100
      ILEFT=IRIGHT
      IF(IW(IRIGHT).EQ.')   ')GOTO333
      GOTO339
  333 CONTINUE
      ISTEPN='333'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ISUM=0
      DO335K=1,IRIGHT
      KREV=IRIGHT-K+1
      IF(IW(KREV).EQ.')   ')ISUM=ISUM+1
      IF(IW(KREV).EQ.'(   ')ISUM=ISUM-1
      IF(ISUM.EQ.0)GOTO337
  335 CONTINUE
      ILEFT=0
  337 CONTINUE
      ILEFT=KREV
  339 CONTINUE
      ISTEPN='339'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=ILEFT+1
      ISTOP=I
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='0   '
      IFOUND='YES'
      GOTO1100
C
  390 CONTINUE
      ISTEPN='390'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ***********************************
C               **  STEP 4--                     **
C               **  TEST FOR THE    0*    CASE.  **
C               ***********************************
C
      IF(IP1.GE.NWP1)GOTO490
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO410
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO410
      IF(IW(IP1).EQ.'/   ')GOTO410
      GOTO100
C
  410 CONTINUE
      ISTEPN='410'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IM1.LE.0)GOTO420
      IF(IW(IM1).EQ.'+   ')GOTO420
      IF(IW(IM1).EQ.'-   ')GOTO420
      IF(IM1.EQ.1.AND.IW(IM1).EQ.'*   ')GOTO420
      IF(IM1.GE.2.AND.IW(IM1).EQ.'*   '.AND.IW(IM2).NE.'*   ')GOTO420
CCCCC IF(IW(IM1).EQ.'/   ')GOTO420
      IF(IW(IM1).EQ.'(   ')GOTO420
      GOTO100
C
  420 CONTINUE
      ISTEPN='420'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IB=IP1
      ILEFT=IB+1
      IF(ILEFT.GE.NWP1)GOTO100
      IRIGHT=ILEFT
      IF(IW(ILEFT).EQ.'(   ')GOTO433
      GOTO439
  433 CONTINUE
      ISTEPN='433'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ISUM=0
      DO435K=ILEFT,NW
      K2=K
      IF(IW(K).EQ.'(   ')ISUM=ISUM-1
      IF(IW(K).EQ.')   ')ISUM=ISUM+1
      IF(ISUM.EQ.0)GOTO437
  435 CONTINUE
      IRIGHT=NW+1
  437 CONTINUE
      IRIGHT=K2
  439 CONTINUE
      ISTEPN='439'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=I+1
      ISTOP=IRIGHT
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='0   '
      IFOUND='YES'
      GOTO1100
C
  490 CONTINUE
      ISTEPN='490'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  100 CONTINUE
      ISTEPN='100'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  990 CONTINUE
      ISTEPN='990'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NWM1=NW-1
      IF(IM1.LE.0)GOTO1100
      IF(IP1.GE.NWP1)GOTO1100
      IF(IW(IM1).EQ.'(   '.AND.IW(I).EQ.'0   '.AND.
     1   IW(IP1).EQ.')   ')GOTO1210
      GOTO1100
C
 1210 CONTINUE
      ISTEPN='1210'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 13--                    **
C               **  TEST FOR THE   *(0)   CASE.  **
C               ***********************************
C
      IF(IM2.LE.0)GOTO1390
      IF(IM2.EQ.1.AND.IW(IM2).EQ.'*   ')GOTO1310
      IF(IM2.GE.2.AND.IW(IM2).EQ.'*   '.AND.IW(IM3).NE.'*   ')GOTO1310
CCCCC IF(IW(IM2).EQ.'/   ')GOTO1310
      GOTO1100
C
 1310 CONTINUE
      ISTEPN='1310'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IP2.GE.NWP1)GOTO1320
      IF(IW(IP2).EQ.'+   ')GOTO1320
      IF(IW(IP2).EQ.'-   ')GOTO1320
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1320
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1320
      IF(IW(IP2).EQ.'/   ')GOTO1320
      IF(IW(IP2).EQ.')   ')GOTO1320
      GOTO1100
C
 1320 CONTINUE
      ISTEPN='1320'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IB=IM2
      IRIGHT=IB-1
      IF(IRIGHT.LE.0)GOTO1100
      ILEFT=IRIGHT
      IF(IW(IRIGHT).EQ.')   ')GOTO1333
      GOTO1339
 1333 CONTINUE
      ISTEPN='1333'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ISUM=0
      DO1335K=1,IRIGHT
      KREV=IRIGHT-K+1
      IF(IW(KREV).EQ.')   ')ISUM=ISUM+1
      IF(IW(KREV).EQ.'(   ')ISUM=ISUM-1
      IF(ISUM.EQ.0)GOTO1337
 1335 CONTINUE
      ILEFT=0
 1337 CONTINUE
      ILEFT=KREV
 1339 CONTINUE
      ISTEPN='1339'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=ILEFT+1
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='0   '
      IFOUND='YES'
      GOTO1100
C
 1390 CONTINUE
      ISTEPN='1390'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ***********************************
C               **  STEP 14--                    **
C               **  TEST FOR THE   (0)*   CASE.  **
C               ***********************************
C
      IF(IP2.GE.NWP1)GOTO1490
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1410
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1410
      IF(IW(IP2).EQ.'/   ')GOTO1410
      GOTO1100
C
 1410 CONTINUE
      ISTEPN='1410'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IM2.LE.0)GOTO1420
      IF(IW(IM2).EQ.'+   ')GOTO1420
      IF(IW(IM2).EQ.'-   ')GOTO1420
      IF(IM2.EQ.1.AND.IW(IM2).EQ.'*   ')GOTO1420
      IF(IM2.GE.2.AND.IW(IM2).EQ.'*   '.AND.IW(IM3).NE.'*   ')GOTO1420
CCCCC IF(IW(IM2).EQ.'/   ')GOTO1420
      IF(IW(IM2).EQ.'(   ')GOTO1420
      GOTO1100
C
 1420 CONTINUE
      ISTEPN='1420'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IB=IP2
      ILEFT=IB+1
      IF(ILEFT.GE.NWP1)GOTO1100
      IRIGHT=ILEFT
      IF(IW(ILEFT).EQ.'(   ')GOTO1433
      GOTO1439
 1433 CONTINUE
      ISTEPN='1433'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      ISUM=0
      DO1435K=ILEFT,NW
      K2=K
      IF(IW(K).EQ.'(   ')ISUM=ISUM-1
      IF(IW(K).EQ.')   ')ISUM=ISUM+1
      IF(ISUM.EQ.0)GOTO1437
 1435 CONTINUE
      IRIGHT=NW+1
 1437 CONTINUE
      IRIGHT=K2
 1439 CONTINUE
      ISTEPN='1439'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=I
      ISTOP=IRIGHT
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      IW(I2)='0   '
      IFOUND='YES'
      GOTO1100
C
 1490 CONTINUE
      ISTEPN='1490'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1100 CONTINUE
      ISTEPN='1101'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
 1990 CONTINUE
      ISTEPN='1990'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
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 DPSIP0--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIP1(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS MULTIPLICATIONS
C              (AND DIVISIONS) BY 1 AND BY (1)   .
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IW(*)
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='DPSI'
      ISUBN2='P1  '
C
      IERROR='YES'
C
      IMIN=1
      I2=1
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 DPSIP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.) **
C               **  FOR THE SEARCH FOR    1    .       **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR    1    .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      IF(IMIN.GE.NWP1)GOTO990
      DO200I=IMIN,NW
      I2=I
      IF(IW(I).EQ.'1   ')GOTO210
  200 CONTINUE
      GOTO990
C
  210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 3--                     **
C               **  TEST FOR THE    *1    CASE.  **
C               ***********************************
C
      IF(IM1.LE.0)GOTO390
      IF(IM1.EQ.1.AND.IW(IM1).EQ.'*   ')GOTO310
      IF(IM1.GE.2.AND.IW(IM1).EQ.'*   '.AND.IW(IM2).NE.'*   ')GOTO310
      IF(IW(IM1).EQ.'/   ')GOTO310
      GOTO100
C
  310 CONTINUE
      IF(IP1.GE.NWP1)GOTO320
      IF(IW(IP1).EQ.'+   ')GOTO320
      IF(IW(IP1).EQ.'-   ')GOTO320
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO320
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO320
      IF(IW(IP1).EQ.'/   ')GOTO320
      IF(IW(IP1).EQ.')   ')GOTO320
      GOTO100
C
  320 CONTINUE
      ISTART=IM1
      ISTOP=I
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  390 CONTINUE
C
C               ***********************************
C               **  STEP 4--                     **
C               **  TEST FOR THE    1*    CASE.  **
C               ***********************************
C
      IF(IP1.GE.NWP1)GOTO490
      IF(IP1.EQ.NW.AND.IW(IP1).EQ.'*   ')GOTO410
      IF(IP1.LE.NWM1.AND.IW(IP1).EQ.'*   '.AND.IW(IP2).NE.'*   ')GOTO410
      GOTO100
C
  410 CONTINUE
      IF(IM1.LE.0)GOTO420
      IF(IW(IM1).EQ.'+   ')GOTO420
      IF(IW(IM1).EQ.'-   ')GOTO420
      IF(IM1.EQ.1.AND.IW(IM1).EQ.'*   ')GOTO420
      IF(IM1.GE.2.AND.IW(IM1).EQ.'*   '.AND.IW(IM2).NE.'*   ')GOTO420
      IF(IW(IM1).EQ.'/   ')GOTO420
      IF(IW(IM1).EQ.'(   ')GOTO420
      GOTO100
C
  420 CONTINUE
      ISTART=I
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO100
C
  490 CONTINUE
C
  100 CONTINUE
C
  990 CONTINUE
C
C               *****************************************
C               **  STEP 11--                          **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.) **
C               **  FOR THE SEARCH FOR    (1)    .     **
C               *****************************************
C
      NUMPAS=1000
      DO1100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 12--             **
C               **  SEARCH FOR   (1)   .  **
C               ****************************
C
      NWM1=NW-1
      NWP1=NW+1
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=I2+1
      NWM1=NW-1
      IF(IMIN.LE.0)GOTO1990
CCCCC IF(IMIN.GE.NWP1M1)GOTO1990
      IF(IMIN.GE.NW)GOTO1990
      DO1200I=IMIN,NWM1
      I2=I
      IM1=I-1
      IP1=I+1
      IF(IW(IM1).EQ.'(   '.AND.IW(I).EQ.'1   '.AND.
     1   IW(IP1).EQ.')   ')GOTO1210
 1200 CONTINUE
      GOTO1990
C
 1210 CONTINUE
      I=I2
      IM1=I-1
      IM2=I-2
      IM3=I-3
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
C               ***********************************
C               **  STEP 13--                    **
C               **  TEST FOR THE   *(1)   CASE.  **
C               ***********************************
C
      IF(IM2.LE.0)GOTO1390
      IF(IM2.EQ.1.AND.IW(IM2).EQ.'*   ')GOTO1310
      IF(IM2.GE.2.AND.IW(IM2).EQ.'*   '.AND.IW(IM3).NE.'*   ')GOTO1310
      IF(IW(IM2).EQ.'/   ')GOTO1310
      GOTO1100
C
 1310 CONTINUE
      IF(IP2.GE.NWP1)GOTO1320
      IF(IW(IP2).EQ.'+   ')GOTO1320
      IF(IW(IP2).EQ.'-   ')GOTO1320
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1320
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1320
      IF(IW(IP2).EQ.'/   ')GOTO1320
      IF(IW(IP2).EQ.')   ')GOTO1320
      GOTO1100
C
 1320 CONTINUE
      ISTART=IM2
      ISTOP=IP1
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO1100
C
 1390 CONTINUE
C
C               ***********************************
C               **  STEP 14--                    **
C               **  TEST FOR THE   (1)*   CASE.  **
C               ***********************************
C
      IF(IP2.GE.NWP1)GOTO1490
      IF(IP2.EQ.NW.AND.IW(IP2).EQ.'*   ')GOTO1410
      IF(IP2.LE.NWM1.AND.IW(IP2).EQ.'*   '.AND.IW(IP3).NE.'*   ')
     1GOTO1410
      GOTO1100
C
 1410 CONTINUE
      IF(IM2.LE.0)GOTO1420
      IF(IW(IM2).EQ.'+   ')GOTO1420
      IF(IW(IM2).EQ.'-   ')GOTO1420
      IF(IM2.EQ.1.AND.IW(IM2).EQ.'*   ')GOTO1420
      IF(IM2.GE.2.AND.IW(IM2).EQ.'*   '.AND.IW(IM3).NE.'*   ')
     1GOTO1420
      IF(IW(IM2).EQ.'/   ')GOTO1420
      IF(IW(IM2).EQ.'(   ')GOTO1420
      GOTO1100
C
 1420 CONTINUE
      ISTART=IM1
      ISTOP=IP2
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      I2=ISTART-1
      GOTO1100
C
 1490 CONTINUE
C
 1100 CONTINUE
C
 1990 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIP1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIPA(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--SIMPLIFY AN ENTIRE EXPRESSION BY REMOVING
C              ALL REDUNDANT PARENTHESES.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY  1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IW(*)
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='DPSI'
      ISUBN2='PA  '
C
      IERROR='NO'
      IMIN=1
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 DPSIPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
      ISUM=0
C
C               **********************************************
C               **  STEP 3--                                **
C               **  SEARCH FOR THE NEXT RIGHT PARENTHESIS.  **
C               **********************************************
C
      IF(IPASS.EQ.1)IMIN=1
      IF(IPASS.GE.2)IMIN=IRIGHT+1
      IF(IMIN.GT.NW)GOTO9000
C
      DO300I=IMIN,NW
      I2=I
      IF(IW(I).EQ.')   ')GOTO350
  300 CONTINUE
      GOTO9000
  350 CONTINUE
      IRIGHT=I2
      ISUM=ISUM+1
C
C               **********************************************
C               **  STEP 4--                                **
C               **  SEARCH FOR THE NEXT (IN REVERSE ORDER)  **
C               **  LEFT PARENTHESIS.                       **
C               **********************************************
C
      IMAX=IRIGHT-1
      IF(IMAX.LT.1)GOTO9000
C
      DO400I=1,IMAX
      IREV=IMAX-I+1
      IF(IW(IREV).EQ.'(   ')GOTO401
      IF(IW(IREV).EQ.')   ')GOTO402
      GOTO400
  401 CONTINUE
      ISUM=ISUM-1
      IF(ISUM.EQ.0)ILEFT=IREV
      IF(ISUM.EQ.0)GOTO490
      GOTO400
  402 CONTINUE
      ISUM=ISUM+1
      GOTO400
  400 CONTINUE
C
      WRITE(ICOUT,411)
  411 FORMAT('***** ERROR IN DPSIPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,412)
  412 FORMAT('      NUMBER OF LEFT PARENTHESES DOES NOT EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,413)
  413 FORMAT('      NUMBER OF RIGHT PARENTHESES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,414)
  414 FORMAT('      THE STRING BEING OPERATED ON IS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      DO415I=1,NW
      WRITE(ICOUT,416)I,IW(I)
  416 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  415 CONTINUE
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  REDUCE REDUNDANT PARENTHESES   **
C               **  IN THIS VICINITY.              **
C               *************************************
C
      CALL DPSIEP(ILEFT,IRIGHT,IW,NW,IBUGA3,IERROR)
C
  100 CONTINUE
C
C               ****************
C               **  STEP 6--  **
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 DPSIPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIRS(IW1,NW1,ISTAR1,ISTOP1,IW2,NW2,ISTAR2,ISTOP2,
     1IBUGA3,IERROR)
C
C     PURPOSE--REPLACE THE STRING IN IW1(.)
C              RESIDING IN LOCATIONS ISTAR1 TO ISTOP1
C              (INCLUSIVELY)
C              BY THE STRING IN IW2(.)
C              RESIDING IN LOCATIONS ISTAR2 TO ISTOP2
C              (INCLUSIVELY)
C              DISPLACE THE ELEMENTS IN IW1(.)
C              BEYOND THE FIELD OF INTEREST APPROPRIATELY.
C              ACCORDINGLY ADJUST THE VALUE OF NW1 =
C              THE NUMBER OF ELEMENTS IN IW1(.).
C     NOTE--THE INPUT ARGUMENTS IW1(.) AND NW1
C           AND ALTERED BY THIS SUBROUTINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY  1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IW1
      CHARACTER*4 IW2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IW1(*)
      DIMENSION IW2(*)
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
      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 DPSIRS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISTAR1,ISTOP1,NW1
   52 FORMAT('ISTAR1,ISTOP1,NW1 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(IW1(I),I=1,MIN(NW1,100))
   53 FORMAT('(IW1(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ISTAR2,ISTOP2,NW2
   54 FORMAT('ISTAR2,ISTOP2,NW2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IW2(I),I=1,MIN(100,NW2))
   55 FORMAT('(IW2(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************
C               **  STEP 1--               **
C               **  INSERT    THE STRING.  **
C               *****************************
C
      ILEN1=ISTOP1-ISTAR1+1
      ILEN2=ISTOP2-ISTAR2+1
      ISHIFT=ILEN2-ILEN1
      IMIN=ISTOP1+1
      IMAX=NW1
      IF(IMIN.GT.IMAX)GOTO150
      DO100I=IMIN,IMAX
      IPS=I+ISHIFT
      IREV=IMAX-I+IMIN
      IREVPS=IREV+ISHIFT
      IF(IREVPS.GE.IREV)IW1(IREVPS)=IW1(IREV)
      IF(IREVPS.LT.IREV)IW1(IPS)=IW1(I)
  100 CONTINUE
  150 CONTINUE
      NW1=NW1+ISHIFT
C
      J=ISTAR1-1
      DO200I=ISTAR2,ISTOP2
      J=J+1
      IW1(J)=IW2(I)
  200 CONTINUE
  250 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIRS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ISTAR1,ISTOP1,NW1
 9012 FORMAT('ISTAR1,ISTOP1,NW1 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)(IW1(I),I=1,MIN(NW1,100))
 9013 FORMAT('(IW1(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTAR2,ISTOP2,NW2
 9014 FORMAT('ISTAR2,ISTOP2,NW2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(IW2(I),I=1,MIN(NW2,100))
 9015 FORMAT('(IW2(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ILEN1,ILEN2,ISHIFT
 9021 FORMAT('ILEN1,ILEN2,ISHIFT = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSISI(IW,NW,IBUGA3,IERROR)
C
C     PURPOSE--ELIMINATE SUPERFLUOUS JUXTAPOSITIONS
C              OF + AND - SIGNS.
C     NOTE--THE INPUT ARGUEMNTS IW(.) AND NW
C           ARE ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY  1979.
C     UPDATED         --JANUARY  1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      DIMENSION IW(*)
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(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSISI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NW
   52 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NW
      WRITE(ICOUT,56)I,IW(I)
   56 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *****************************************
C               **  STEP 1--                           **
C               **  SET UP A LARGE DO LOOP             **
C               **  FOR MULTIPLE PASSES THROUGH IW(.)  **
C               **  FOR THE SEARCH FOR SIGNS  .        **
C               *****************************************
C
      NUMPAS=1000
      DO100IPASS=1,NUMPAS
C
C               ****************************
C               **  STEP 2--              **
C               **  SEARCH FOR  SIGNS  .  **
C               ****************************
C
      NWM1=NW-1
      IF(NWM1.LT.1)GOTO9000
      DO200I=1,NW
      I2=I
      IP1=I+1
      IF(IW(I).EQ.'+   '.AND.IW(IP1).EQ.'+   ')GOTO210
      IF(IW(I).EQ.'+   '.AND.IW(IP1).EQ.'-   ')GOTO220
      IF(IW(I).EQ.'-   '.AND.IW(IP1).EQ.'+   ')GOTO230
      IF(IW(I).EQ.'-   '.AND.IW(IP1).EQ.'-   ')GOTO240
  200 CONTINUE
      GOTO9000
C
  210 CONTINUE
      ISTART=IP1
      ISTOP=ISTART
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      GOTO100
C
  220 CONTINUE
      ISTART=I2
      ISTOP=ISTART
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      GOTO100
C
  230 CONTINUE
      ISTART=IP1
      ISTOP=ISTART
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      GOTO100
C
  240 CONTINUE
      ISTART=IP1
      ISTOP=ISTART
      CALL DPSIES(ISTART,ISTOP,IW,NW,IBUGA3,IERROR)
      IW(I2)='+   '
      GOTO100
C
  100 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 DPSISI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NW
 9012 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NW
      WRITE(ICOUT,9016)I,IW(I)
 9016 FORMAT('I,IW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSIS2(ISTART,ISTOP,IW,NW,IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--SIMPLIFY CERTAIN STRINGS
C              INVOLVING SIMPLE (= BINARY) ARITHMETIC OPERATIONS
C              (ADDITION, SUBTRACTION, MULTIPLICATION,
C              AND EXPONENTIATION--NOT DIVISION)
C              OF 2 SINGLE-DIGIT INTEGERS WITH THE OUTPUT BEING NECESSARILY INTE
C              THE INTERNAL STRING STARTS WITH ISTART (INCLUSIVE)
C              AND STOPS WITH ISTOP (INCLUSIVE).
C              ALSO, IF THE STRING HAS LENGTH OF ONLY 1
C              (OR IS REDUCED TO LENGTH OF ONLY 1),
C              THEN AN ADDITIONAL STEP IS TAKEN IN
C              THE ELIMINATION OF THE ASSUMED PARENTHESES AT
C              LOCATIONS ISTART-1 AND ISTOP+1.
C     NOTE--THE INPUT ARGUMENTS IW(.) AND NW
C           AND ALTERED BY THIS SUBROUTINE.
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED         --JANUARY   1981.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IW
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 IOP
      CHARACTER*4 IVALID
      CHARACTER*4 IHOUT
C
      DIMENSION IW(*)
C
      DIMENSION IHOUT(80)
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='DPSI'
      ISUBN2='S2  '
C
      IERROR='NO'
C
      IOP='UNKN'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'SIS2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,IERROR
   52 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ISTART,ISTOP,NW
   53 FORMAT('ISTART,ISTOP,NW = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(IW(I),I=1,MIN(NW,100))
   54 FORMAT('(IW(.) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************
C               **  STEP 0--                             **
C               **  DETERMINE THE LENGTH OF THE STRING.  **
C               **  CHECK FOR LENGTH OF STRING = 1.      **
C               **  IF FOUND, AND IF AN INTEGER,         **
C               **  THEN ELIMINATE THE LEADING           **
C               **  AND TRAILING PARENTHESES.            **
C               **  CHECK FOR LENGTH OF STRING = 3.      **
C               **  IF FOUND, CONTINUE ON.               **
C               *******************************************
C
      ILEN=ISTOP-ISTART+1
      IF(ILEN.EQ.1)GOTO210
      IF(ILEN.EQ.3)GOTO230
      IF(ILEN.EQ.4)GOTO240
      GOTO9000
C
C               *********************************
C               **  STEP 1--                   **
C               **  TREAT THE LENGTH = 1 CASE  **
C               *********************************
C
  210 CONTINUE
C
C               **********************************
C               **  STEP 1.1--                  **
C               **  CONVERT THE WORD            **
C               **  FROM HOLLARITH TO INTEGER.  **
C               **********************************
C
      IMIN=ISTART
      IMAX=ISTART
      CALL DPCOHI(IMIN,IMAX,IW,NW,IVALID,VAL1,IVAL1,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES'.OR.IVALID.EQ.'NO')GOTO9000
C
C               ********************************************
C               **  STEP 1.2--                            **
C               **  CHECK FOR PRIOR AND POST PARENTHESES  **
C               **  AND ELIMINATE THEM.                   **
C               ********************************************
C
      ISTAM1=ISTART-1
      ISTAP1=ISTART+1
      IF(ISTAM1.LT.1)GOTO9000
      IF(ISTAP1.GT.NW)GOTO9000
      IF(IW(ISTAM1).EQ.'(   '.AND.IW(ISTAP1).EQ.')   ')GOTO215
      GOTO9000
C
  215 CONTINUE
      JMIN=ISTART+1
      JMAX=ISTART+1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      JMIN=ISTART-1
      JMAX=ISTART-1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      GOTO9000
C
C               **********************************
C               **  STEP 3--                    **
C               **  TREAT THE LENGTH = 3 CASE.  **
C               **********************************
C
  230 CONTINUE
C
C               ***************************************
C               **  STEP 3.1--                       **
C               **  CONVERT FIRST WORD OUT OF THE 3  **
C               **  FROM HOLLARITH TO INTEGER.       **
C               **  CONVERT LAST  WORD OUT OF THE 3  **
C               **  FROM HOLLARITH TO INTEGER.       **
C               **  DETERMINE TYPE OF OPERATION      **
C               **  BY EXAMINING THE SECOND WORD     **
C               **  OUT OF THE 3.                    **
C               ***************************************
C
      IMIN=ISTART
      IMAX=ISTART
      CALL DPCOHI(IMIN,IMAX,IW,NW,IVALID,VAL1,IVAL1,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES'.OR.IVALID.EQ.'NO')GOTO9000
C
      IMIN=ISTOP
      IMAX=ISTOP
      CALL DPCOHI(IMIN,IMAX,IW,NW,IVALID,VAL2,IVAL2,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES'.OR.IVALID.EQ.'NO')GOTO9000
C
      ILOC=ISTART+1
      IF(IW(ILOC).EQ.'+   ')IOP='+   '
      IF(IW(ILOC).EQ.'-   ')IOP='-   '
      IF(IW(ILOC).EQ.'*   ')IOP='*   '
CCCCC IF(IW(ILOC).EQ.'/   ')IOP='/   '
      IF(IW(ILOC).EQ.'**  ')IOP='**  '
      IF(IOP.EQ.'UNKN')GOTO9000
C
C               *******************************************
C               **  STEP 3.2--                           **
C               **  CARRY OUT THE ARITHMETIC OPERATION.  **
C               *******************************************
C
      IF(IOP.EQ.'+   ')IRES=IVAL1+IVAL2
      IF(IOP.EQ.'-   ')IRES=IVAL1-IVAL2
      IF(IOP.EQ.'*   ')IRES=IVAL1*IVAL2
CCCCC IF(IOP.EQ.'/   ')IRES=IVAL1/IVAL2
      IF(IOP.EQ.'**  ')IRES=IVAL1**IVAL2
C
C               **********************************
C               **  STEP 3.3--                  **
C               **  CONVERT RESULT              **
C               **  FROM INTEGER TO HOLLARITH.  **
C               **********************************
C
      CALL DPCOIH(IRES,IHOUT,NOUT,IVALID,IBUGA3,ISUBRO,IERROR)
C
C               ************************************************************
C               **  STEP 3.4--                                            **
C               **  ELIMINATE THE LAST 2 WORDS OF THE                     **
C               **  ORIGINAL 3-WORD STRING,                               **
C               ************************************************************
C
      JMIN=ISTOP-1
      JMAX=ISTOP
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
C
C               *****************************
C               **  STEP 3.5--             **
C               **  INSERT RESULT STRING   **
C               **  (OF LENGTH NOUT)       **
C               **  INTO IW                **
C               **  (STARTING AT           **
C               **  LOCATION ISTART).      **
C               *****************************
C
      CALL DPSIIS(ISTART,IW,NW,IHOUT,NOUT,IBUGA3,IERROR)
C
C               ************************************************************
C               **  STEP 3.6--                                            **
C               **  IF THE INSERTED STRING HAD LENGTH = 1,                **
C               **  (SO THAT THE CURRENT EXPRESSION INSIDE THE            **
C               **  PARENTHESES NOW HAS INTERNAL LENGTH OF 1)             **
C               **  ELIMINATE THE PARENTHESES.                            **
C               ************************************************************
C
      IF(NOUT.NE.1)GOTO9000
C
      ISTAM1=ISTART-1
      ISTAP1=ISTART+1
      IF(ISTAM1.LT.1)GOTO9000
      IF(ISTAP1.GT.NW)GOTO9000
      IF(IW(ISTAM1).EQ.'(   '.AND.IW(ISTAP1).EQ.')   ')GOTO235
      GOTO9000
C
  235 CONTINUE
      JMIN=ISTART+1
      JMAX=ISTART+1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      JMIN=ISTART-1
      JMAX=ISTART-1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      GOTO9000
C
C               **********************************
C               **  STEP 4--                    **
C               **  TREAT THE LENGTH = 4 CASE.  **
C               **********************************
C
  240 CONTINUE
C
C               ***************************************
C               **  STEP 4.1--                       **
C               **  CONVERT FIRST WORD OUT OF THE 4  **
C               **  FROM HOLLARITH TO INTEGER.       **
C               **  CONVERT LAST  WORD OUT OF THE 4  **
C               **  FROM HOLLARITH TO INTEGER.       **
C               **  DETERMINE TYPE OF OPERATION      **
C               **  BY EXAMINING THE SECOND AND      **
C               **  THIRD WORDS OUT OF THE 4.        **
C               ***************************************
C
      IMIN=ISTART
      IMAX=ISTART
      CALL DPCOHI(IMIN,IMAX,IW,NW,IVALID,VAL1,IVAL1,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES'.OR.IVALID.EQ.'NO')GOTO9000
C
      IMIN=ISTOP
      IMAX=ISTOP
      CALL DPCOHI(IMIN,IMAX,IW,NW,IVALID,VAL2,IVAL2,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES'.OR.IVALID.EQ.'NO')GOTO9000
C
      ILOC=ISTART+1
      ILOCP1=ILOC+1
      IF(IW(ILOC).EQ.'*   '.AND.IW(ILOCP1).EQ.'*   ')IOP='**  '
      IF(IOP.EQ.'UNKN')GOTO9000
C
C               *******************************************
C               **  STEP 4.2--                           **
C               **  CARRY OUT THE ARITHMETIC OPERATION.  **
C               *******************************************
C
      IF(IOP.EQ.'**  ')IRES=IVAL1**IVAL2
C
C               **********************************
C               **  STEP 4.3--                  **
C               **  CONVERT RESULT              **
C               **  FROM INTEGER TO HOLLARITH.  **
C               **********************************
C
      CALL DPCOIH(IRES,IHOUT,NOUT,IVALID,IBUGA3,ISUBRO,IERROR)
C
C               ************************************************************
C               **  STEP 4.4--                                            **
C               **  ELIMINATE THE LAST 3 WORDS OF THE                     **
C               **  ORIGINAL 4-WORD STRING,                               **
C               ************************************************************
C
      JMIN=ISTOP-2
      JMAX=ISTOP
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
C
C               *****************************
C               **  STEP 4.5--             **
C               **  INSERT RESULT STRING   **
C               **  (OF LENGTH NOUT)       **
C               **  INTO IW                **
C               **  (STARTING AT           **
C               **  LOCATION ISTART).      **
C               *****************************
C
      CALL DPSIIS(ISTART,IW,NW,IHOUT,NOUT,IBUGA3,IERROR)
C
C               ************************************************************
C               **  STEP 4.6--                                            **
C               **  IF THE INSERTED STRING HAD LENGTH = 1,                **
C               **  (SO THAT THE CURRENT EXPRESSION INSIDE THE            **
C               **  PARENTHESES NOW HAS INTERNAL LENGTH OF 1)             **
C               **  ELIMINATE THE PARENTHESES.                            **
C               ************************************************************
C
      IF(NOUT.NE.1)GOTO9000
C
      ISTAM1=ISTART-1
      ISTAP1=ISTART+1
      IF(ISTAM1.LT.1)GOTO9000
      IF(ISTAP1.GT.NW)GOTO9000
      IF(IW(ISTAM1).EQ.'(   '.AND.IW(ISTAP1).EQ.')   ')GOTO245
      GOTO9000
C
  245 CONTINUE
      JMIN=ISTART+1
      JMAX=ISTART+1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      JMIN=ISTART-1
      JMAX=ISTART-1
      CALL DPSIES(JMIN,JMAX,IW,NW,IBUGA3,IERROR)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'SIS2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSIS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IERROR
 9012 FORMAT('IBUGA3,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NW
 9013 FORMAT('NW = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)(IW(I),I=1,MIN(NW,115))
 9014 FORMAT('(IW(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSKIP(IHARG,IARGT,IARG,NUMARG,IDEFSK,
     1ISKIP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE NUMBER OF LINES TO BE SKIPPED
C              AT THE BEGINNING OF A READ COMMAND
C              OR A SERIAL READ COMMAND.
C              THIS ALLOWS TEXT AND HEADER LINES TO BE
C              SKIPPED OVER AT THE BEGINNING OF A DATA FILE.
C              THE SPECIFIED NUMBER OF SKIP LINES WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ISKIP.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSK (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--ISKIP  (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1993.  ALLOW SKIP ----
C     UPDATED         --OCTOBER   1997.  FIX SKIP ----
C     UPDATED         --OCTOBER   1997.  SET SKIP AUTOMATIC
C                                        EQUIVALENT TO SKIP ----
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
CCCCC OCTOBER 1997.  MAKE "SKIP AUTOMATIC" EQUIVALENT TO A "SKIP ----"
CCCCC IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1170
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1993
      IF(IHARG(NUMARG).EQ.'----')GOTO1170
CCCCC THE FOLLOWING LINE WAS FIXED, COMMAND PARSING RETURNS A SINGLE
CCCCC "-".     OCTOBER 1997
      IF(IHARG(NUMARG).EQ.'-')GOTO1170
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPSKIP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR SKIP ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      TO SKIP OVER 3 NON-DATA LINES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AT THE BEGINNING OF READS AND SERIAL READS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      SKIP 3 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      ISKIP=IDEFSK
      GOTO1180
C
 1160 CONTINUE
      ISKIP=IARG(NUMARG)
      GOTO1180
C
CCCCC THE FOLLOWING SECTION WAS ADDED    SEPTEMBER 1993
 1170 CONTINUE
      IFOUND='YES'
      ISKIP=-1
      IF(IFEEDB.EQ.'OFF')GOTO1179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1171)
 1171 FORMAT('HEADER LINES WILL BE SKIPPED UNITL A LINE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1172)
 1172 FORMAT('    WITH    ----    IS ENCOUNTERED')
      CALL DPWRST('XXX','BUG ')
 1179 CONTINUE
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE NUMBER OF HEADER LINES TO BE SKIPPED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ISKIP
 1182 FORMAT('    HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ISKIP
 8111 FORMAT('THE CURRENT NUMBER OF LINES TO BE SKIPPED IS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFSK
 8112 FORMAT('THE DEFAULT NUMBER OF LINES TO BE SKIPPED IS ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPSLOC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A SPREAD-LOCATION (S-L) PLOT--
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/8
C     ORIGINAL VERSION--AUGUST    1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      DIMENSION TEMP2(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(1))
      EQUIVALENCE (GARBAG(IGARB5),TEMP2(1))
C
C-----COMMON----------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPHO'
      ISUBN2='MO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLH=0
C
C               *******************************************
C               **  TREAT THE SPREAD-LOCATION PLOT CASE  **
C               *******************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='SLOC'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'LOCA'.AND.
     1IHARG(2).EQ.'PLOT')GOTO112
      GOTO119
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *************************************************
C               **  STEP 1--                                   **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               **************************************************
C               **  STEP 3--                                    **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS **
C               **  (NLEFT)                                     **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.   **
C               **************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A SPREAD-LOCATION PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)MINN2
  326 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,329)(IANS(I),I=1,IWIDTH)
  329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPSLOC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,MIN(IWIDTH,80))
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               **************************************************
C               **  STEP 5--                                    **
C               **  IF A SECOND ARGUMENT EXISTS (IT MUST), THEN **
C               **  THIS                                        **
C               **  INDICATES THAT THE VALUES IN THE            **
C               **  FIRST VARIABLE ARE TO BE GROUPED            **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;     **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE    **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS AND    **
C               **  STANDARD DEVIATIONS ARE TO BE COMPUTED.     **
C               **  THE VALUES IN THE SECOND VARIABLE           **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD    **
C               **  DEVIATION,                                  **
C               **  ETC.  IN THE RESULTING I   PLOT     .       **
C               **  THE VALUES IN THE SECOND VARIABLE           **
C               **  NEED NOT HAVE BEEN PREVIOUSLY               **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.      **
C               **  IF WE HAVE THE 2-VARIABLE CASE,             **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.
C               **************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.2)GOTO530
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPSLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A SPREAD-LOCATION PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)NUMV2
  522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,524)(IANS(I),I=1,MIN(IWIDTH,80))
  524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO590
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPSLOC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A SPREAD-LOCATION PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,NLEFT
  584 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZIZONTAL AXIS ',
     1'VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHHOR,NHOR
  586 FORMAT('                  ',A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,MIN(IWIDTH,80))
  588 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *************************************************
C               **  STEP 6--                                   **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FORM THE RESPONSE VARIABLE            **
C               **  AND THE SECOND VARIABLE (IF EXISTENT)      **
C               *************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      IF(NUMV2.LE.1)GOTO660
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
  660 CONTINUE
      NLOCAL=J
C
C               **************************************************
C               **  STEP 8--                                    **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS       **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.          **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE **
C               **  LINE,                                       **
C               **  AND THE UPPER CONFIDENCE LINE.              **
C               **  DEFINE THE NUMBER OF PLOT POINTS  (NPLOTP). **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV)**
C               **************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  809 CONTINUE
      CALL DPSLO2(Y1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,
     1XIDTEM,TEMP,TEMP2,MAXOBV,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSLOC--')
      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)ISIZE
 9014 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSLO2(Y,X,N,NUMV2,ICASPL,ISIZE,
     1XIDTEM,TEMP,TEMP2,MAXOBV,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE AN SPREAD-LOCATION PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/8
C     ORIGINAL VERSION--AUGUST    1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C----------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
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='DPSL'
      ISUBN2='O2  '
C
      I2=0
      AN=0.0
C
      N50=1
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPSLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPSLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=Y(1)
      DO60I=1,N
      IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPSLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPSLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMV2
   71 FORMAT('N,ICASPL,NUMV2 = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO72I=1,N
      WRITE(ICOUT,73)I,Y(I),X(I)
   73 FORMAT('I, Y(I), X(I) = ',I8,2F15.7)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   90 CONTINUE
C
C               *************************************************
C               **  STEP 1--                                   **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES    **
C               **  FOR VARIABLE 2 (THE GROUP VARIABLE).       **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS      **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE    **
C               **  WHICH IS AN ERROR CONDITION FOR A          **
C               **  SPREAD-LOCATION PLOT .                     **
C               *************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSET=0
      DO160I=1,N
      IF(NUMSET.EQ.0)GOTO165
      DO170J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO160
  170 CONTINUE
  165 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  160 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
      XID1=XIDTEM(1)
      XID2=XIDTEM(NUMSET)
C
  190 CONTINUE
C
      IF(NUMSET.EQ.0)WRITE(ICOUT,191)
  191 FORMAT('ERROR IN DPSLO2   SUBROUTINE--NUMSET = 0')
      IF(NUMSET.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.0)GOTO9000
      IF(NUMSET.EQ.0)IERROR='YES'
C
      IF(NUMSET.EQ.N)WRITE(ICOUT,192)
  192 FORMAT('ERROR IN DPSLO2   SUBROUTINE--NUMSET = N')
      IF(NUMSET.EQ.N)CALL DPWRST('XXX','BUG ')
      IF(NUMSET.EQ.N)IERROR='YES'
      IF(NUMSET.EQ.N)GOTO9000
C
C               ************************************************
C               **  STEP 4--                                  **
C               **  DETERMINE PLOT COORDINATES                **
C               ************************************************
C
 1100 CONTINUE
C
      ISTEPN='4'
      IF(IBUGG3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      ITAG=1
      DO1110ISET=1,NUMSET
C
      K=0
      DO1120I=1,N
      IF(X(I).EQ.XIDTEM(ISET))K=K+1
      IF(X(I).EQ.XIDTEM(ISET))TEMP(K)=Y(I)
 1120 CONTINUE
      NI=K
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1121)ISET,XIDTEM(ISET),NI
 1121 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NI.LE.1)GOTO1110
      CALL SORT(TEMP,NI,TEMP)
      IWRITE='OFF'
      SUM=0.0
      CALL MEDIAN(TEMP,NI,IWRITE,TEMP2,MAXOBV,XMED,IBUGG3,IERROR)
      ITAG=ITAG+1
      JSTART=J+1
      DO1130I=1,NI
        J=J+1
        Y2(J)=ABS(TEMP(I)-XMED)
        X2(J)=XMED
        D2(J)=REAL(ITAG)
 1130 CONTINUE
C
      CALL MEDIAN(Y2(JSTART),NI,IWRITE,TEMP2,MAXOBV,XMED2,IBUGG3,
     1            IERROR)
      DO1140I=JSTART,J
        Y2(I)=SQRT(Y2(I))
 1140 CONTINUE
      J=J+1
      Y2(J)=SQRT(XMED2)
      X2(J)=XMED
      D2(J)=1.0
C
 1110 CONTINUE
C
      N2=J
      NPLOTV=2
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSLO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N,NUMSET,N2,IERROR
 9012 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMV2
 9013 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)AN,NI
 9014 FORMAT('AN,NI = ',E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSMO2(Y,W,N,ICASSM,IFILWI,IDEGRE,IRSTRI,NUMCRS,MAXCRS,
     1TEMP,MAXN,
     1RESSD,RESDF,PRED2,RES2,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE PERFORMS A SMOOTHING
C              OF THE DATA IN THE INPUT VECTOR Y.
C     NOTE--ASSUMPTION--DATA ARE EQUALLY-SPACED.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF EQUALLY-SPACED OBSERVATIONS
C                                TO BE SMOOTHED.
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C                       IFILWI = THE ODD INTEGER WIDTH OF THE
C                                SMOOTHING FUNCTION.
C                                (IFILWI MUST BE ODD,
C                                MUST BE BETWEEN 1 AND 999
C                                (INCLUSIVE),
C                                AND MUST BE BETWEEN IDEGRE+1 AND N
C                                (INCLUSIVE)).
C                       IDEGRE = THE INTEGER DEGREE OF THE LEAST
C                                SQUARES POLYNOMIAL.
C                                (IDEGRE MUST BE BETWEEN 0 AND 5,
C                                INCLUSIVE).
C     OUTPUT ARGUMENTS--PRED2  = THE SINGLE PRECISION VECTOR
C                                OF 'PREDICTED' OR SMOOTHED
C                                VALUES.
C                       RES2   = THE SINGLE PRECISION VECTOR
C                                OF RESIDUALS.
C                                (THE I-TH RESIDUAL IS THE DIFFERENCE
C                                BETWEEN THE I-TH INPUT VALUE AND
C                                THE I-TH SMOOTHED VALUE--
C                                RES2(I) = Y(I) - PRED2(I)).
C                       S      = THE SINGLE PRECISION VALUE OF THE
C                                RESIDUAL STANDARD DEVIATION
C                                (A MEASURE OF THE GOODNESS OF
C                                THE FIT OR THE SMOOTHING).
C     OUTPUT--COMPUTED (MOVING) LEAST SQUARES SMOOTHED VALUES,
C             RESIDUALS, AND THE RESIDUAL STANDARD DEVIATION.
C     PRINTING--YES (6 LINES)
C               OF INFORMATION INVOLVING
C               THE NUMBER OF OBSERVATIONS,
C               THE DEGREE OF THE SMOOTHING FUNCTION,
C               THE WIDTH  OF THE SMOOTHING FUNCTION,
C               THE STANDARD DEVIATION OF THE ORIGINAL
C               (UNSMOOTHED) DATA ABOUT THE SAMPLE MEAN,
C               THE STANDARD DEVIATION OF THE RESIDUALS
C               AFTER A (MOVING) AVERAGE SMOOTHING WITH
C               THE SAME WIDTH (IFILWI),
C               AND THE STANDARD DEVIATION OF THE RESIDUALS
C               AFTER THE LEAST SQUARES SMOOTHING WITH
C               DEGREE IDEGRE AND WIDTH IFILWI.
C     RESTRICTIONS--THERE IS NO UPPER LIMIT RESTRICTION ON N.
C                   IDEGRE MUST BE BETWEEN 0 AND 5 (INCLUSIVE).
C                   IFILWI MUST BE ODD,
C                          MUST BE BETWEEN 1 AND 999 (INCLUSIVE), AND
C                          MUST BE BETWEEN IDEGRE+1 AND N (INCLUSIVE).
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--MACHINE-INDEPENDENT ANSI FORTRAN (1977)
C     COMMENT--NEAR THE ENDS OF THE DATA SET WHERE
C              THE SMOOTHING FUNCTION GOES 'OFF THE END',
C              THE PREDICTED VALUE IS ASSIGNED THE VALUE OF THE
C              OBSERVATION ITSELF.  THIS IS DUE TO THE
C              COMPLICATED FORM OF THE NON-SYMMETRIC WEIGHTING
C              FOR THE LEAST SQUARES SMOOTHING NEAR THE ENDPOINTS.
C              THIS WILL BE CORRECTED IN THE FUTURE.
C     REFERENCE--HILDEBRAND, F. B.  INTRODUCTION TO NUMERICAL
C                ANALYSISY PAGES 295-302, ESPECIALLY 301.
C              --RALSTON, A.  A FIRST COURSE IN NUMERICAL ANALYSIS,
C                PAGES 250-254.
C              --SAVITSKY, A. AND GOLAY, M. J. E.  'SMOOTHING AND
C                DIFFERENTIATION OF DATA BY SIMPLIFIED LEAST
C                SQUARES PROCEDURES', ANALYTICAL CHEMISTRY,
C                JULY, 1964, PAGES 1627-1639.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1975.
C     UPDATED         --JULY      1976.
C     UPDATED         --JUNE      1978.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASSM
      CHARACTER*4 IRSTRI
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASS2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION W(*)
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
      DIMENSION IRSTRI(*)
      DIMENSION TEMP(*)
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='DPSM'
      ISUBN2='O2  '
C
      IERROR='NO'
C
      MAXDEG=6
      MAXWIN=MAXN-1
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 DPSMO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,IBUGA3
   52 FORMAT('N,IBUGA3 = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASSM,IFILWI,IDEGRE
   53 FORMAT('ICASSM,IFILWI,IDEGRE = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMCRS,MAXCRS
   54 FORMAT('NUMCRS,MAXCRS = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)(IRSTRI(I),I=1,MAXCRS)
   55 FORMAT('IRSTRI(.) = ',30A1)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),W(I)
   57 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASS2='OTSM'
      IF(ICASSM.EQ.'SM')ICASS2='SM'
      IF(ICASSM.EQ.'0SM')ICASS2='SM'
      IF(ICASSM.EQ.'1SM')ICASS2='SM'
      IF(ICASSM.EQ.'2SM')ICASS2='SM'
      IF(ICASSM.EQ.'3SM')ICASS2='SM'
      IF(ICASSM.EQ.'4SM')ICASS2='SM'
      IF(ICASSM.EQ.'5SM')ICASS2='SM'
      IF(ICASSM.EQ.'6SM')ICASS2='SM'
      IF(ICASSM.EQ.'7SM')ICASS2='SM'
      IF(ICASSM.EQ.'8SM')ICASS2='SM'
      IF(ICASSM.EQ.'9SM')ICASS2='SM'
      IF(ICASSM.EQ.'10SM')ICASS2='SM'
      IF(ICASSM.EQ.'ROSM')ICASS2='ROSM'
C
      IF(N.LT.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPSMO2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS NON-POSITIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** NOTE FROM DPSMO2--THE RESPONSE VARIABLE ',
     1'ONLY HAS 1 ELEMENT')
      CALL DPWRST('XXX','BUG ')
      DO122I=1,N
      PRED2(I)=Y(I)
      RES2(I)=0.0
  122 CONTINUE
      GOTO9000
  129 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPSMO2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO132I=1,N
      PRED2(I)=Y(I)
      RES2(I)=0.0
  132 CONTINUE
      GOTO9000
  139 CONTINUE
C
      IF(IFILWI.GT.N)GOTO140
      GOTO149
  140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)
  141 FORMAT('***** ERROR IN DPSMO2--THE WIDTH OF THE SMOOTHING ',
     1' WINDOW MUST NOT BE LARGER THAN THE SAMPLE SIZE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,142)IFILWI,N
  142 FORMAT('      WIDTH = ',I8,' SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  149 CONTINUE
C
      IF(IFILWI.GT.MAXWIN)GOTO150
      GOTO159
  150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,151)MAXWIN
  151 FORMAT('***** ERROR IN DPSMO2--THE WIDTH OF THE SMOOTHING ',
     1'WINDOW MUST NOT BE LARGER THAN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,152)IFILWI
  152 FORMAT('WIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  159 CONTINUE
C
      IF(IFILWI.EQ.1)GOTO160
      GOTO169
  160 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,161)
  161 FORMAT('***** NOTE FROM DPSMO2--THE WIDTH OF THE SMOOTHING ',
     1'WINDOW IS 1')
      CALL DPWRST('XXX','BUG ')
      DO162I=1,N
      PRED2(I)=Y(I)
      RES2(I)=0.0
  162 CONTINUE
      IERROR='YES'
      GOTO9000
  169 CONTINUE
C
      IF(IFILWI.EQ.N)GOTO170
      GOTO179
  170 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,171)
  171 FORMAT('***** ERROR IN DPSMO2--THE WIDTH OF THE SMOOTHING ',
     1'WINDOW IS IDENTICAL TO THE SAMPLE SIZE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,172)IFILWI,N
  172 FORMAT('WIDTH = ',I8,' SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  179 CONTINUE
C
      IEVODD=IFILWI-2*(IFILWI/2)
      IF(IEVODD.EQ.0)GOTO180
      GOTO189
  180 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,181)
  181 FORMAT('***** ERROR IN DPSMO2--THE WIDTH OF THE SMOOTHIN ',
     1'WINDOW MUST BE ODD (AS OPPOSED TO EVEN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,182)
  182 FORMAT('WIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  189 CONTINUE
C
      IF(IFILWI.LE.0)GOTO200
      GOTO209
  200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,201)
  201 FORMAT('***** ERROR IN DPSMO2--THE WIDTH OF THE SMOOTHING ',
     1'WINDOW WAS NON-POSITIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,202)IFILWI
  202 FORMAT('WIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  209 CONTINUE
C
      IF(ICASSM.NE.'SM')GOTO229
      IF(IDEGRE.GE.IFILWI)GOTO220
      GOTO229
  220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,221)
  221 FORMAT('***** ERROR IN DPSMO2--THE DEGREE OF THE SMOOTHING ',
     1'FUNCTION MUST BE SMALLER THAN THE SMOOTHING WIDTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,222)IDEGRE,IFILWI
  222 FORMAT('DEGREE = ',I8,' WIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  229 CONTINUE
C
      IF(ICASSM.NE.'SM')GOTO239
      IF(IDEGRE.GT.MAXDEG)GOTO230
      GOTO239
  230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,231)MAXDEG
  231 FORMAT('***** ERROR IN DPSMO2--THE DEGREE OF THE SMOOTHING ',
     1'FUNCTION MUST NOT EXCEED ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,232)IDEGRE
  232 FORMAT('DEGREE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  239 CONTINUE
C
      IF(ICASSM.NE.'SM')GOTO249
      IWM1=IFILWI-1
      IF(IDEGRE.EQ.IWM1)GOTO240
      GOTO249
  240 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,241)
  241 FORMAT('***** NOTE FROM DPSMO2--THE DEGREE OF THE SMOOTHING ',
     1'FUNCTION WAS ONE LESS THAN THE WIDTH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)IFILWI
  242 FORMAT('      THEREFORE, THE SMOOTHED VALUES WILL BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)
  243 FORMAT('      IDENTICAL TO THE RAW DATA VALUES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,244)IDEGRE,IFILWI
  244 FORMAT('DEGREE = ',I8,' WIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO245I=1,N
      PRED2(I)=Y(I)
      RES2(I)=Y(I)
  245 CONTINUE
      GOTO9000
  249 CONTINUE
C
CCCCC IF(ICASS2.EQ.'ROSM')GOTO260
CCCCC GOTO269
CC260 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,261)
CC261 FORMAT('***** ERROR IN DPSMO2--THE ROBUST SMOOTHING')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,262)
CC262 FORMAT('      CAPABILITY IS NOT YET AVAILABLE')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
CC269 CONTINUE
C
  290 CONTINUE
C
C               ************************************************
C               **  STEP 2--                                  **
C               **  BRANCH TO THE APPROPRIATE SMOOTHING CASE  **
C               ************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFILWI.LE.0)IFILWI=3
      IF(IFILWI.GE.1)IFILWI=IFILWI
      IEVODD=IFILWI-2*(IFILWI/2)
      IF(IEVODD.EQ.0)IFILWI=IFILWI+1
C
      WIDTH=IFILWI
      IWHALF=(IFILWI/2)+1
      M=IFILWI/2
      AM=M
C
      IF(ICASSM.EQ.'0SM')GOTO1100
      IF(ICASSM.EQ.'1SM')GOTO1100
      IF(ICASSM.EQ.'2SM')GOTO1120
      IF(ICASSM.EQ.'3SM')GOTO1120
      IF(ICASSM.EQ.'4SM')GOTO1140
      IF(ICASSM.EQ.'5SM')GOTO1140
      IF(ICASSM.EQ.'6SM')GOTO1160
      IF(ICASSM.EQ.'7SM')GOTO1160
      IF(ICASSM.EQ.'8SM')GOTO1180
      IF(ICASSM.EQ.'9SM')GOTO1180
      IF(ICASSM.EQ.'10SM')GOTO1200
C
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.0)GOTO1100
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.1)GOTO1100
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.2)GOTO1120
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.3)GOTO1120
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.4)GOTO1140
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.5)GOTO1140
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.6)GOTO1160
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.7)GOTO1160
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.8)GOTO1180
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.8)GOTO1180
      IF(ICASSM.EQ.'SM'.AND.IDEGRE.EQ.10)GOTO1200
C
      IF(ICASSM.EQ.'MESM')GOTO2100
      IF(ICASSM.EQ.'MDSM')GOTO2200
      IF(ICASSM.EQ.'MMSM')GOTO2300
      IF(ICASSM.EQ.'MRSM')GOTO2400
      IF(ICASSM.EQ.'UQSM')GOTO2500
      IF(ICASSM.EQ.'LQSM')GOTO2600
      IF(ICASSM.EQ.'MXSM')GOTO2700
      IF(ICASSM.EQ.'MNSM')GOTO2800
      IF(ICASSM.EQ.'TRSM')GOTO2900
      IF(ICASSM.EQ.'HMSM')GOTO3000
C
      IF(ICASSM.EQ.'ROSM')GOTO3100
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)
  811 FORMAT('***** INTERNAL ERROR IN DPSMO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,812)
  812 FORMAT('      ICASSM NOT ONE OF THE ALLOWABLE TYPES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,813)
  813 FORMAT('      SM, 0SM, 1SM, ..., 10SM, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,814)
  814 FORMAT('      MESM, MDSM, MMSM, MRSM, UQSM, LQSM, MXSM, ',
     1'MNSM,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,815)
  815 FORMAT('      TRSM, OR ROSM')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,816)ICASSM
  816 FORMAT('      ICASSM = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               **********************************************
C               **  STEP 3--                                **
C               **  TREAT THE LEAST SQUARES SMOOTHING CASE  **
C               **********************************************
C
C               ********************************************
C               **  STEP 3.1--                            **
C               **  DETERMINE LEAST SQUARES COEFFICIENTS  **
C               **  FOR THE SPECIFIED DEGREE AND WIDTH    **
C               ********************************************
C
 1100 CONTINUE
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      FACTOR=1.0/WIDTH
      DO1101I=1,IWHALF
      IREV=IFILWI-I+1
      TEMP(I)=FACTOR
      TEMP(IREV)=TEMP(I)
 1101 CONTINUE
      GOTO1900
C
 1120 CONTINUE
      FACTOR=3.0/((4.0*AM*AM-1.0)*(2.0*AM+3.0))
      DO1121I=1,IWHALF
      IREV=IFILWI-I+1
      R=I-M-1
      TEMP(I)=FACTOR*((3.0*AM*AM+3.0*AM-1.0)-(5.0*R*R))
      TEMP(IREV)=TEMP(I)
 1121 CONTINUE
      GOTO1900
C
 1140 CONTINUE
      FACTOR=15.0/(4.0*(4.0*AM*AM-1.0)*(4.0*AM*AM-9.0)*(2.0*AM+5.0))
      DO1141I=1,IWHALF
      IREV=IFILWI-I+1
      R=I-M-1
      TERM1=15.0*(AM**4)+30.0*(AM**3)-35.0*(AM**2)-50.0*AM+12.0
      TERM2=35.0*(2.0*(AM**2)+2.0*AM-3.0)*(R**2)
      TERM3=63.0*(R**4)
      TEMP(I)=FACTOR*(TERM1-TERM2+TERM3)
      TEMP(IREV)=TEMP(I)
 1141 CONTINUE
      GOTO1900
C
 1160 CONTINUE
      GOTO1290
C
 1180 CONTINUE
      GOTO1290
C
 1200 CONTINUE
      GOTO1290
C
 1290 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1291)
 1291 FORMAT('***** ERROR IN DPSMO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1292)
 1292 FORMAT('      THE CURRENT MAXIMUM ALLOWABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1293)
 1293 FORMAT('      DEGREE FOR LEAST SQUARES SMOOTHING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)MAXDEG
 1294 FORMAT('      IS DEGREE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1295)IDEGRE
 1295 FORMAT('      THE SPECIFIED DEGREE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               **********************************************
C               **  STEP 3.2--                              **
C               **  COMPUTE SMOOTHED (= PREDICTED) VALUES.  **
C               **********************************************
C
 1900 CONTINUE
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1910I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO1930
      SUM=0.0
      ICOUNT=0
      DO1920J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      SUM=SUM+TEMP(ICOUNT)*Y(J)
 1920 CONTINUE
      PRED2(I)=SUM
      GOTO1910
 1930 CONTINUE
      PRED2(I)=Y(I)
 1910 CONTINUE
      GOTO5000
C
C               ***********************************
C               **  STEP 4--                     **
C               **  TREAT THE FOLLOWING CASES--  **
C               **     1) MOVING MEAN            **
C               **     2) MOVING MEDIAN          **
C               **     3) MOVING MIDMEAN         **
C               **     4) MOVING MIDRANGE        **
C               **     5) MOVING UPPER QUARTILE  **
C               **     6) MOVING LOWER QUARTILE  **
C               **     7) MOVING MINIMUM         **
C               **     8) MOVING MAXIMUM         **
C               **     9) MOVING TRIANGLE        **
C               **    10) HAMMING                **
C               ***********************************
C
C               *************************************
C               **  STEP 4.1--                     **
C               **  TREAT THE MOVING AVERAGE CASE  **
C               *************************************
C
 2100 CONTINUE
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      IWHALF=(IFILWI/2)+1
      M=IFILWI/2
      COEF=1.0/WIDTH
C
      DO2110I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2150
      SUM=0.0
      ICOUNT=0
      DO2120J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      SUM=SUM+COEF*Y(J)
 2120 CONTINUE
      PRED2(I)=SUM
      GOTO2110
 2150 CONTINUE
      PRED2(I)=Y(I)
 2110 CONTINUE
C
      GOTO5000
C
C               ************************************
C               **  STEP 4.2--                    **
C               **  TREAT THE MOVING MEDIAN CASE  **
C               ************************************
C
 2200 CONTINUE
      ISTEPN='4.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      IWHALF=(IFILWI/2)+1
      HALFSQ=IWHALF*IWHALF
      M=IFILWI/2
C
      DO2210I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2250
      SUM=0.0
      ICOUNT=0
      DO2220J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      TEMP(ICOUNT)=Y(J)
 2220 CONTINUE
      CALL SORT(TEMP,IFILWI,TEMP)
      PRED2(I)=TEMP(IWHALF)
      GOTO2210
 2250 CONTINUE
      PRED2(I)=Y(I)
 2210 CONTINUE
C
      GOTO5000
C
C               *************************************
C               **  STEP 4.3--                     **
C               **  TREAT THE MOVING MIDMEAN CASE  **
C               *************************************
C
 2300 CONTINUE
      ISTEPN='4.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      P1=0.25
      P2=0.25
C
      WIDTH=IFILWI
      IWHALF=(IFILWI/2)+1
      HALFSQ=IWHALF*IWHALF
      M=IFILWI/2
C
      DO2310I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2370
      SUM=0.0
      ICOUNT=0
      DO2320J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      TEMP(ICOUNT)=Y(J)
 2320 CONTINUE
      CALL SORT(TEMP,IFILWI,TEMP)
      IWP1=P1*WIDTH+0.0001
      ISTART=IWP1+1
      IWP2=P2*WIDTH+0.0001
      ISTOP=IFILWI-IWP2
      SUM=0.0
      K=0
      IF(ISTART.GT.ISTOP)GOTO2360
      DO2330L=ISTART,ISTOP
      K=K+1
      SUM=SUM+TEMP(L)
 2330 CONTINUE
      AK=K
      YMIDM=SUM/AK
      GOTO2380
 2360 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2361)
 2361 FORMAT('***** INTERNAL ERROR IN MMMSMO SUBROUTINE--',
     1 'THE START INDEX IS HIGHER THAN THE STOP INDEX ',
     1'IN DO LOOP 2330')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2380 CONTINUE
      PRED2(I)=YMIDM
      GOTO2310
 2370 CONTINUE
      PRED2(I)=Y(I)
 2310 CONTINUE
C
      GOTO5000
C
C               **************************************
C               **  STEP 4.4--                      **
C               **  TREAT THE MOVING MIDRANGE CASE  **
C               **************************************
C
 2400 CONTINUE
      ISTEPN='4.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      M=IFILWI/2
C
      DO2410I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2450
      SUM=0.0
      ICOUNT=0
      DO2420J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      TEMP(ICOUNT)=Y(J)
 2420 CONTINUE
      CALL SORT(TEMP,IFILWI,TEMP)
      PRED2(I)=(TEMP(1)+TEMP(IFILWI))/2.0
      GOTO2410
 2450 CONTINUE
      PRED2(I)=Y(I)
 2410 CONTINUE
C
      GOTO5000
C
C               ********************************************
C               **  STEP 4.5--                            **
C               **  TREAT THE MOVING UPPER QUARTILE CASE  **
C               ********************************************
C
 2500 CONTINUE
      ISTEPN='4.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      P1=0.25
      IWP1=P1*WIDTH+0.0001
      IWP2=IFILWI-IWP1
      M=IFILWI/2
C
      DO2510I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2550
      SUM=0.0
      ICOUNT=0
      DO2520J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      TEMP(ICOUNT)=Y(J)
 2520 CONTINUE
      CALL SORT(TEMP,IFILWI,TEMP)
      PRED2(I)=TEMP(IWP2)
      GOTO2510
 2550 CONTINUE
      PRED2(I)=Y(I)
 2510 CONTINUE
C
      GOTO5000
C
C               ********************************************
C               **  STEP 4.6--                            **
C               **  TREAT THE MOVING LOWER QUARTILE CASE  **
C               ********************************************
C
 2600 CONTINUE
      ISTEPN='4.6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      P1=0.25
      IWP1=P1*WIDTH+0.0001
      M=IFILWI/2
C
      DO2610I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2650
      SUM=0.0
      ICOUNT=0
      DO2620J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      TEMP(ICOUNT)=Y(J)
 2620 CONTINUE
      CALL SORT(TEMP,IFILWI,TEMP)
      PRED2(I)=TEMP(IWP1)
      GOTO2610
 2650 CONTINUE
      PRED2(I)=Y(I)
 2610 CONTINUE
C
C               *************************************
C               **  STEP 4.7--                     **
C               **  TREAT THE MOVING MAXIMUM CASE  **
C               *************************************
C
 2700 CONTINUE
      ISTEPN='4.7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      M=IFILWI/2
C
      DO2710I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2750
      YMAX=Y(JMIN)
      DO2720J=JMIN,JMAX
      IF(Y(J).GT.YMAX)YMAX=Y(J)
 2720 CONTINUE
      PRED2(I)=YMAX
      GOTO2710
 2750 CONTINUE
      PRED2(I)=Y(I)
 2710 CONTINUE
C
      GOTO5000
C
C               *************************************
C               **  STEP 4.8--                     **
C               **  TREAT THE MOVING MINIMUM CASE  **
C               *************************************
C
 2800 CONTINUE
      ISTEPN='4.8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      M=IFILWI/2
C
      DO2810I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2850
      YMIN=Y(JMIN)
      DO2820J=JMIN,JMAX
      IF(Y(J).LT.YMIN)YMIN=Y(J)
 2820 CONTINUE
      PRED2(I)=YMIN
      GOTO2810
 2850 CONTINUE
      PRED2(I)=Y(I)
 2810 CONTINUE
C
      GOTO5000
C
C               *******************************************
C               **  STEP 4.9--                           **
C               **  TREAT THE TRIANGULAR SMOOTHING CASE  **
C               *******************************************
C
 2900 CONTINUE
      ISTEPN='4.9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=IFILWI
      IWHALF=(IFILWI/2)+1
      HALFSQ=IWHALF*IWHALF
      M=IFILWI/2
C
      DO2910I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO2950
      SUM=0.0
      ICOUNT=0
      DO2920J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      IF(ICOUNT.LE.IWHALF)COEF=ICOUNT
      IF(ICOUNT.GT.IWHALF)COEF=IFILWI-ICOUNT+1
      COEF=COEF/HALFSQ
      SUM=SUM+COEF*Y(J)
 2920 CONTINUE
      PRED2(I)=SUM
      GOTO2910
 2950 CONTINUE
      PRED2(I)=Y(I)
 2910 CONTINUE
C
      GOTO5000
C
C               *******************************************
C               **  STEP 4.10--                          **
C               **  TREAT THE HAMMING  SMOOTHING CASE    **
C               *******************************************
C
 3000 CONTINUE
      ISTEPN='4.10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WIDTH=3
      IWHALF=2
      HALFSQ=IWHALF*IWHALF
      M=1
C
      DO3010I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO3050
      SUM=0.0
      ICOUNT=0
      DO3020J=JMIN,JMAX
      ICOUNT=ICOUNT+1
      IF(ICOUNT.LE.IWHALF)COEF=ICOUNT
      IF(ICOUNT.GT.IWHALF)COEF=IFILWI-ICOUNT+1
      COEF=COEF/HALFSQ
      SUM=SUM+COEF*Y(J)
 3020 CONTINUE
      PRED2(I)=SUM
      GOTO3010
 3050 CONTINUE
      PRED2(I)=Y(I)
 3010 CONTINUE
C
      GOTO5000
C
C               ***************************************
C               **  STEP 5--                         **
C               **  TREAT THE ROBUST SMOOTHING CASE  **
C               ***************************************
C
 3100 CONTINUE
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3191)
C3191 FORMAT('***** ERROR IN DPSMO2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3192)
C3192 FORMAT('      THE ROBUST SMOOTHING CAPABILITY')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3193)
C3193 FORMAT('      IS NOT YET AVAILABLE IN DATAPLOT.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C
      CALL DP3RSR(Y,TEMP,N,PRED2,RES2,IBUGA3,IERROR)
      GOTO5000
C
C               *************************
C               **  STEP 11--          **
C               **  COMPUTE RESIDUALS  **
C               *************************
C
 5000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5050I=1,N
      RES2(I)=Y(I)-PRED2(I)
 5050 CONTINUE
C
C               *********************************************************
C               **  STEP 12--                                          **
C               **  COMPUTE VARIOUS MEASURES OF    GOODNESS OF FIT   --    **
C               **    1) THE STANDARD DEVIATION AND                    **
C               **       THE AVERAGE ABSOLUTE DEVIATION                **
C               **       OF THE RAW DATA                               **
C               **       (THAT IS, THE UNSMOOTHED DATA);               **
C               **    2) THE STANDARD DEVIATION AND                    **
C               **       THE AVERAGE ABSOLUTE DEVIATION                **
C               **       OF THE RESIDUALS FROM THE                     **
C               **       MOVING AVERAGE FIT WITH THE SPECIFIED WIDTH;  **
C               **    3) THE STANDARD DEVIATION AND                    **
C               **       THE AVERAGE ABSOLUTE DEVIATION                **
C               **       OF THE RESIDUALS FROM THE                     **
C               **       MOVING LEAST SQUARES FIT WITH THE             **
C               **       SPECIFIED DEGREE AND WIDTH.                   **
C               *********************************************************
C
 5100 CONTINUE
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      AN=N
      SUM=0.0
      DO5150I=1,N
      SUM=SUM+Y(I)
 5150 CONTINUE
      YBAR=SUM/AN
C
      SUMSQ=0.0
      SUMAB=0.0
      DO5155I=1,N
      RESY=Y(I)-YBAR
      SUMSQ=SUMSQ+RESY*RESY
      SUMAB=SUMAB+ABS(RESY)
 5155 CONTINUE
      VARY=SUMSQ/(AN-1.0)
      SDY=0.0
      IF(VARY.GT.0.0)SDY=SQRT(VARY)
      AARY=SUMAB/AN
C
      SUMSQ=0.0
      SUMAB=0.0
      DO5160I=1,N
      JMIN=I-M
      JMAX=I+M
      IF(JMIN.LT.1.OR.JMAX.GT.N)GOTO5160
      SUM=0.0
      DO5165J=JMIN,JMAX
      SUM=SUM+(1.0/WIDTH)*Y(J)
 5165 CONTINUE
      PREDMA=SUM
      RESMA=Y(I)-PREDMA
      SUMSQ=SUMSQ+RESMA*RESMA
      SUMAB=SUMAB+ABS(RESMA)
 5160 CONTINUE
      VARMA=SUMSQ/(AN-1.0)
      SDMA=0.0
      IF(VARMA.GT.0.0)SDMA=SQRT(VARMA)
      AARMA=SUMAB/AN
C
      DENOM=N-1
      SUMSQ=0.0
      SUMAB=0.0
      DO5170I=1,N
      SUMSQ=SUMSQ+RES2(I)**2
      SUMAB=SUMAB+ABS(RES2(I))
 5170 CONTINUE
      VAR=SUMSQ/DENOM
      S=0.0
      IF(VAR.GT.0.0)S=SQRT(VAR)
      RESDF=DENOM
      RESSD=S
      RESAAR=SUMAB/AN
C
C               ****************************
C               **  STEP 13--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
 6000 CONTINUE
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6105)
 6105 FORMAT('SMOOTHING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
C
      IF(ICASS2.EQ.'SM')WRITE(ICOUT,6111)
 6111 FORMAT('      SMOOTHING FUNCTION--LEAST SQUARES')
      IF(ICASS2.EQ.'SM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MESM')WRITE(ICOUT,6112)
 6112 FORMAT('      SMOOTHING FUNCTION--MOVING MEAN')
      IF(ICASSM.EQ.'MESM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MDSM')WRITE(ICOUT,6113)
 6113 FORMAT('      SMOOTHING FUNCTION--MOVING MEDIAN')
      IF(ICASSM.EQ.'MDSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MMSM')WRITE(ICOUT,6114)
 6114 FORMAT('      SMOOTHING FUNCTION--MOVING MIDMEAN')
      IF(ICASSM.EQ.'MMSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MRSM')WRITE(ICOUT,6115)
 6115 FORMAT('      SMOOTHING FUNCTION--MOVING MIDRANGE')
      IF(ICASSM.EQ.'MRSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'UQSM')WRITE(ICOUT,6116)
 6116 FORMAT('      SMOOTHING FUNCTION--MOVING UPPER QUARTILE')
      IF(ICASSM.EQ.'UQSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'LQSM')WRITE(ICOUT,6117)
 6117 FORMAT('      SMOOTHING FUNCTION--MOVING LOWER QUARTILE')
      IF(ICASSM.EQ.'LQSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MXSM')WRITE(ICOUT,6118)
 6118 FORMAT('      SMOOTHING FUNCTION--MOVING MAXIMUM')
      IF(ICASSM.EQ.'MXSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MNSM')WRITE(ICOUT,6119)
 6119 FORMAT('      SMOOTHING FUNCTION--MOVING MINIMUM')
      IF(ICASSM.EQ.'MNSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'TRSM')WRITE(ICOUT,6120)
 6120 FORMAT('      SMOOTHING FUNCTION--MOVING TRIANGLE')
      IF(ICASSM.EQ.'TRSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'HMSM')WRITE(ICOUT,6121)
 6121 FORMAT('      SMOOTHING FUNCTION--HAMMING')
      IF(ICASSM.EQ.'HMSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'ROSM')WRITE(ICOUT,6122)
 6122 FORMAT('      SMOOTHING FUNCTION--ROBUST (3RSR)')
      IF(ICASSM.EQ.'ROSM')CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,6131)N
 6131 FORMAT('      NUMBER OF OBSERVATIONS       = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'LSSQ')WRITE(ICOUT,6132)IFILWI
 6132 FORMAT('      WIDTH  OF SMOOTHING FUNCTION = ',I8)
      IF(ICASS2.EQ.'LSSQ')CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'OTSQ')WRITE(ICOUT,6132)IFILWI
      IF(ICASS2.EQ.'OTSQ')CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'LSSQ')WRITE(ICOUT,6133)IDEGRE
 6133 FORMAT('      DEGREE OF SMOOTHING FUNCTION = ',I8)
      IF(ICASS2.EQ.'LSSQ')CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'ROSM')WRITE(ICOUT,6134)(IRSTRI(I),I=1,30)
 6134 FORMAT('      DEFINING STRING              = ',30A1)
      IF(ICASS2.EQ.'ROSM')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6135)
 6135 FORMAT('****************************************************',
     1'*******************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6136)
 6136 FORMAT('*                               * ','   RESIDUAL    ',
     1' * ','   AVERAGE     ',' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6137)
 6137 FORMAT('*                               * ','   STANDARD    ',
     1' * ','   ABSOLUTE    ',' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6138)
 6138 FORMAT('*                               * ','   DEVIATION   ',
     1' * ','   RESIDUAL    ',' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6139)
 6139 FORMAT('*                               * ',' (DIVISOR=N-1) ',
     1' * ','  (DIVISOR=N)  ',' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6135)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6141)SDY,AARY
 6141 FORMAT('* NO SMOOTHING                  * ',F15.7,' * ',F15.7,
     1' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6142)
 6142 FORMAT('* (RAW DATA)',5X,'         ',4X,'  * ',15X,' * ',15X,
     1' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6143)
 6143 FORMAT('*           ',5X,'         ',4X,'  * ',15X,' * ',15X,
     1' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6144)SDMA,AARMA
 6144 FORMAT('* MOVING AVERAGE SMOOTHING      * ',F15.7,' * ',F15.7,
     1' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6145)IFILWI
 6145 FORMAT('* WIDTH =',I8,'         ',4X,'  * ',15X,' * ',15X,
     1' *')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6143)
      CALL DPWRST('XXX','BUG ')
C
      IF(ICASS2.EQ.'SM')WRITE(ICOUT,6151)RESSD,RESAAR
 6151 FORMAT('* LEAST SQUARES SMOOTHING       * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASS2.EQ.'SM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MESM')WRITE(ICOUT,6152)RESSD,RESAAR
 6152 FORMAT('* MOVING MEAN SMOOTHING         * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MESM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MDSM')WRITE(ICOUT,6153)RESSD,RESAAR
 6153 FORMAT('* MOVING MEDIAN SMOOTHING       * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MDSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MMSM')WRITE(ICOUT,6154)RESSD,RESAAR
 6154 FORMAT('* MOVING MIDMEAN SMOOTHING      * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MMSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MRSM')WRITE(ICOUT,6155)RESSD,RESAAR
 6155 FORMAT('* MOVING MIDRANGE SMOOTHING     * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MRSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'UQSM')WRITE(ICOUT,6156)RESSD,RESAAR
 6156 FORMAT('* MOVING UPPER QUAR. SMOOTHING  * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'UQSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'LQSM')WRITE(ICOUT,6157)RESSD,RESAAR
 6157 FORMAT('* MOVING LOWER QUAR. SMOOTHING  * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'LQSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MXSM')WRITE(ICOUT,6158)RESSD,RESAAR
 6158 FORMAT('* MOVING MAXIMUM SMOOTHING      * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MXSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'MNSM')WRITE(ICOUT,6159)RESSD,RESAAR
 6159 FORMAT('* MOVING MINIMUM SMOOTHING      * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'MNSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'TRSM')WRITE(ICOUT,6160)RESSD,RESAAR
 6160 FORMAT('* MOVING TRIANGLE SMOOTHING     * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'TRSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'HMSM')WRITE(ICOUT,6161)RESSD,RESAAR
 6161 FORMAT('* HAMMING SMOOTHING             * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'HMSM')CALL DPWRST('XXX','BUG ')
      IF(ICASSM.EQ.'ROSM')WRITE(ICOUT,6162)RESSD,RESAAR
 6162 FORMAT('* ROBUST SMOOTHING (3RSR)       * ',F15.7,' * ',F15.7,
     1' *')
      IF(ICASSM.EQ.'ROSM')CALL DPWRST('XXX','BUG ')
C
      IF(ICASS2.EQ.'SM')WRITE(ICOUT,6171)IFILWI,IDEGRE
 6171 FORMAT('* WIDTH =',I8,' DEGREE =',I4,'  * ',15X,' * ',15X,
     1' *')
      IF(ICASS2.EQ.'SM')CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'OTSM')WRITE(ICOUT,6172)IFILWI
 6172 FORMAT('* WIDTH =',I8,'         ',4X,'  * ',15X,' * ',15X,
     1' *')
      IF(ICASS2.EQ.'OTSM')CALL DPWRST('XXX','BUG ')
      IF(ICASS2.EQ.'ROSM')WRITE(ICOUT,6173)(IRSTRI(I),I=1,30)
 6173 FORMAT('* ',30A1,'* ',15X,' * ',15X,
     1' *')
      IF(ICASS2.EQ.'ROSM')CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,6135)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 6190 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 DPSMO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASSM,ICASS2,IFILWI,IDEGRE
 9013 FORMAT('ICASSM,ICASS2,IFILWI,IDEGRE = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMCRS,MAXCRS
 9014 FORMAT('NUMCRS,MAXCRS = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)(IRSTRI(I),I=1,MAXCRS)
 9015 FORMAT('IRSTRI(.) = ',30A1)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I),PRED2(I),RES2(I)
 9017 FORMAT('I,Y(I),W(I),PRED2(I),RES2(I) = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSMOO(IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A SMOOTHING OPERATION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1983.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IRSTRI
      CHARACTER*4 ICASSM
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(MAXOBV)
      DIMENSION IRSTRI(30)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION W(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),TEMP(1))
      EQUIVALENCE (GARBAG(IGARB2),PRED2(1))
      EQUIVALENCE (GARBAG(IGARB3),RES2(1))
      EQUIVALENCE (GARBAG(IGARB4),W(1))
CCCCC END CHANGE
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
      IERROR='NO'
C
      ISUBN1='DPSM'
      ISUBN2='OO  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=1
      MINN2=2
C
      ICASEQ='UNKN'
C
      MAXCRS=30
      NUMCRS=0
      DO10I=1,MAXCRS
      IRSTRI(I)=' '
   10 CONTINUE
C
C               ********************************
C               **  TREAT THE SMOOTHING CASE  **
C               ********************************
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 DPSMOO--')
      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 ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1.1--                 **
C               **  SEARCH FOR SMOOTH          **
C               **  (WITH UNSPECIFIED DEGREE)  **
C               *********************************
C
      ICASSM='SM'
C
      IF(ICOM.EQ.'SMOO')GOTO110
C
C               *******************************************
C               **  STEP 1.2--                           **
C               **  SEARCH FOR ROBUST         SMOOTHING  **
C               *******************************************
C
      ICASSM='ROSM'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ROBU'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.3--                           **
C               **  SEARCH FOR MOVING AVERAGE SMOOTHING  **
C               *******************************************
C
      ICASSM='MESM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'AVER'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'XBAR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AVER'.AND.IHARG(1).EQ.'SMOO')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MEAN'.AND.IHARG(1).EQ.'SMOO')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'XBAR'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.4--                           **
C               **  SEARCH FOR MOVING MEDIAN   SMOOTHING  **
C               *******************************************
C
      ICASSM='MDSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MEDI'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MEDI'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.5--                           **
C               **  SEARCH FOR MOVING MIDMEAN SMOOTHING  **
C               *******************************************
C
      ICASSM='MMSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MIDM'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MIDM'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.6--                           **
C               **  SEARCH FOR MOVING MIDRANGE SMOOTHING **
C               *******************************************
C
      ICASSM='MRSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MIDR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MIDR'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               **************************************************
C               **  STEP 1.7--                                  **
C               **  SEARCH FOR MOVING UPPER QUARTILE SMOOTHING  **
C               **************************************************
C
      ICASSM='UQSM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'UPPE'.AND.IHARG(2).EQ.'QUAR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'QUAR'.AND.
     1IHARG(2).EQ.'SMOO')GOTO112
C
C               **************************************************
C               **  STEP 1.8--                                  **
C               **  SEARCH FOR MOVING LOWER QUARTILE SMOOTHING  **
C               **************************************************
C
      ICASSM='LQSM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'LOWE'.AND.IHARG(2).EQ.'QUAR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'QUAR'.AND.
     1IHARG(2).EQ.'SMOO')GOTO112
C
C               *******************************************
C               **  STEP 1.9--                           **
C               **  SEARCH FOR MOVING MAXIMUM  SMOOTHING **
C               *******************************************
C
      ICASSM='MXSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MAXI'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MAXI'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.10--                          **
C               **  SEARCH FOR MOVING MINIMUM  SMOOTHING **
C               *******************************************
C
      ICASSM='MNSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'MINI'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'MIDR'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *********************************************
C               **  STEP 1.11--                            **
C               **  SEARCH FOR MOVING TRIANGULAR SMOOTHING **
C               *********************************************
C
      ICASSM='TRSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'TRIA'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'TRIA'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *********************************************
C               **  STEP 1.12--                            **
C               **  SEARCH FOR HAMMING SMOOTHING **
C               *********************************************
C
      ICASSM='HMSM'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MOVI'.AND.IHARG(1).EQ.'HAMM'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HAMM'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 0-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='0SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'0'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ZERO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'0'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'0'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ZERO'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CONS'.AND.IHARG(1).EQ.'SMOO')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RECT'.AND.IHARG(1).EQ.'SMOO')GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FLAT'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.21--                          **
C               **  SEARCH FOR 1-ST DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='1SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'ST'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.22--                          **
C               **  SEARCH FOR 2-ND DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='2SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'ND'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.23--                          **
C               **  SEARCH FOR 3-RD DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='3SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'RD'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.24--                          **
C               **  SEARCH FOR 4-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='4SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.25--                          **
C               **  SEARCH FOR 5-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='5SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.26--                          **
C               **  SEARCH FOR 6-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='6SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.27--                          **
C               **  SEARCH FOR 7-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='7SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.28--                          **
C               **  SEARCH FOR 8-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='8SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.29--                          **
C               **  SEARCH FOR 9-TH DEGREE    SMOOTHING  **
C               *******************************************
C
      ICASSM='9SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               *******************************************
C               **  STEP 1.20--                          **
C               **  SEARCH FOR 10-TH DEGREE   SMOOTHING  **
C               *******************************************
C
      ICASSM='10SM'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SMOO')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'SMOO')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'SMOO')GOTO111
C
C               ********************************************
C               **  STEP 1.31--                           **
C               **  SINCE VALID COMMAND NOT FOUND, EXIT.  **
C               ********************************************
C
      ICASSM='    '
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=0
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(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 DPSMOO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH AN SMOOTHING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 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 DPSMOO--')
      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 SMOOTHING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE DONE)')
      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 6--                                             **
C               **  DETERMINE IF THE ANALYST                             **
C               **  HAS SPECIFIED THE WIDTH                              **
C               **  DESIRED FOR THE SMOOTHING FUNCTION.                  **
C               **  THIS IS DONE BY PRIOR USE OF THE                     **
C               **  FILTER WIDTH    COMMAND.                             **
C               **  IF FOUND, USE THE SPECIFIED VALUE                    **
C               **  (WHICH MUST BE BETWEEN 1 AND 1000, INCLUSIVE);       **
C               **  IF NOT FOUND, USE THE DEFAULT VALUE                  **
C               **  (USUALLY 11) WHICH WILL BE DEFINED                   **
C               **  IN THE SUBROUTINE DPSMO2.                            **
C               **  DETERMINE IF THE ANALYST                             **
C               **  HAS SPECIFIED THE DEGREE                             **
C               **  DESIRED FOR THE SMOOTHING FUNCTION.                  **
C               **  THIS IS DONE BY PRIOR USE OF THE                     **
C               **  POLYNOMIAL DEGREE    COMMAND.                        **
C               **  IF FOUND, USE THE SPECIFIED VALUE                    **
C               **  (WHICH MUST BE BETWEEN 1 AND 1000, INCLUSIVE);       **
C               **  IF NOT FOUND, USE THE DEFAULT VALUE                  **
C               **  (USUALLY 1) WHICH WILL BE DEFINED                    **
C               **  IN THE SUBROUTINE DPSMO2.                            **
C               ***********************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(FILWID.EQ.CPUMIN)IFILWI=3
      IF(FILWID.NE.CPUMIN)IFILWI=FILWID+0.5
C
      IDEGRE=IDEG
      IF(IDEG.LT.0)IDEGRE=1
      IF(ICASSM.EQ.'0SM')IDEGRE=0
      IF(ICASSM.EQ.'1SM')IDEGRE=1
      IF(ICASSM.EQ.'2SM')IDEGRE=2
      IF(ICASSM.EQ.'3SM')IDEGRE=3
      IF(ICASSM.EQ.'4SM')IDEGRE=4
      IF(ICASSM.EQ.'5SM')IDEGRE=5
      IF(ICASSM.EQ.'6SM')IDEGRE=6
      IF(ICASSM.EQ.'7SM')IDEGRE=7
      IF(ICASSM.EQ.'8SM')IDEGRE=8
      IF(ICASSM.EQ.'9SM')IDEGRE=9
      IF(ICASSM.EQ.'10SM')IDEGRE=10
C
C               *******************************************
C               **  STEP 7--                             **
C               **  FOR THE ROBUST SMOOTHING CASE ONLY,  **
C               **  EXTRACT THE DEFINING STRING.         **
C               *******************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC IF(ICASSM.EQ.'ROSM')GOTO810
      GOTO990
C
  810 CONTINUE
      IMAX=IWIDTH-5
      IF(IMAX.LT.1)GOTO829
      DO820I=1,IMAX
      IP1=I+1
      IP2=I+2
      IP3=I+3
      IP4=I+4
      IP5=I+5
      IF(IANS(I).EQ.'R'.AND.IANS(IP1).EQ.'O'.AND.
     1IANS(IP2).EQ.'B'.AND.IANS(IP3).EQ.'U'.AND.
     1IANS(IP4).EQ.'S'.AND.IANS(IP5).EQ.'T')GOTO839
  820 CONTINUE
  829 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,831)
  831 FORMAT('***** INTERNAL ERROR IN DPSMOO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,832)
  832 FORMAT('      THE 6A1 STRING   ROBUST   NOT FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,833)
  833 FORMAT('      ON THE COMMAND LINE EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,834)
  834 FORMAT('      THE CASE WAS PREVIOUSLY IDENTIFIED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,835)
  835 FORMAT('      AS BEING THE ROBUST SMOOTHING CASE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,836)ICASSM,IFILWI
  836 FORMAT('ICASSM,IFILWI = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,837)
  837 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,838)(IANS(I),I=1,IWIDTH)
  838 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  839 CONTINUE
      IEND1=IP5
C
  840 CONTINUE
      IEND1P=IEND1+1
      IF(IEND1P.GT.IWIDTH)GOTO859
      DO850I=IEND1P,IWIDTH
      I2=I
      IF(IANS(I).NE.' ')GOTO869
  850 CONTINUE
  859 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,861)
  861 FORMAT('***** ERROR IN DPSMOO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,862)
  862 FORMAT('      THE WORD     ROBUST   ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,863)
  863 FORMAT('      SHOULD HAVE BEEN (BUT WAS NOT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,864)
  864 FORMAT('      FOLLOWED BY A CHARACTER STRING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,865)
  865 FORMAT('      DEFINING THE DESIRED ROBUST SMOOTHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,866)ICASSM,IFILWI
  866 FORMAT('ICASSM,IFILWI = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,867)
  867 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,868)(IANS(I),I=1,IWIDTH)
  868 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  869 CONTINUE
      ISTAR2=I2
C
  870 CONTINUE
      ICOUNT=0
      IF(ISTAR2.GT.IWIDTH)GOTO889
      DO880I=ISTAR2,IWIDTH
      IF(IANS(I).EQ.' ')GOTO899
      ICOUNT=ICOUNT+1
      IF(ICOUNT.GT.MAXCRS)GOTO889
      IRSTRI(ICOUNT)=IANS(I)
  880 CONTINUE
      GOTO899
  889 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,891)
  891 FORMAT('***** ERROR IN DPSMOO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,892)
  892 FORMAT('      THE CHARACTER STRING WHICH DEFINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,893)
  893 FORMAT('      THE DESIRED ROBUST SMOOTHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,894)
  894 FORMAT('      HAS EXCEEDED THE MAXIMUM ALLOWABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,895)MAXCRS
  895 FORMAT('      LENGTH OF ',I8,' CHARACTERS.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,897)
  897 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,898)(IANS(I),I=1,IWIDTH)
  898 FORMAT('      ',120A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  899 CONTINUE
      NUMCRS=ICOUNT
C
  990 CONTINUE
C
C               ****************************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPSMO2--
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 SMOOTHED VALUES.  **
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 DPSMOO, AS WE ARE ABOUT TO CALL DPSMO2--')
      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 DPSMO2(Y,W,NS,ICASSM,IFILWI,IDEGRE,IRSTRI,NUMCRS,MAXCRS,
     1TEMP,MAXN,
     1RESSD,RESDF,PRED2,RES2,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
C
C     THE FOLLOWING CORRECTION WAS BASED ON
C     COMMENTS FROM DAVE EVANS     AUGUST 1987
CCCCC IREPU='ON'
      IREPU='OFF'
      REPSD=(-999.0)
      REPDF=(-999.0)
      ALFCDF=(-999.99)
C
      IRESU='ON'
C
      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSMOO--')
      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)NS,ICASSM
 9014 FORMAT('NS,ICASSM = ',I8,2X,A4)
      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
