      SUBROUTINE MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1MAXNPP,ISEED,IBOOSS,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
CCCCC THE FOLLOWING LINE WAS ADDED    APRIL 1992
     1BARHEF,BARWEF,
CCCCC THE FOLLOWING LINE WAS ADDED    MARCH 1996
     1IRHSTG,IHSTCW,
CCCCC THE FOLLOWING LINE WAS ADDED    OCTOBER 2002
     1ICAPSW,IFORSW,
     1IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAINGR.
C              (THE   GR    AT THE END OF    MAINGR   STANDS FOR   GRAPHICS)
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES GRAPHICS COMMANDS.
C              THE GRAPHICS COMMANDS SEARCHED FOR BY MAINGR ARE AS FOLLOWS--
C
C                     ANOP PLOT
C                     PROPORTION PLOT (= ANOP PLOT)
C                     ... BOX PLOT
C                     BOX-COX NORMALITY PLOT
C                     BOX-COX HOMOSCEDASTICITY PLOT
C                     BOX-COX SYMMETRY PLOT
C                     BOX-COX LINEARITY PLOT
C                     BOX-COX STANDARDIZED EFFECTS PLOT
C                     COMPLEX DEMODULATION ... PLOT
C                     CONTOUR PLOT
C                     ... CONTROL CHART
C                     ... CORRELATION PLOT
C                     ... FFT PLOT
C                     ... FREQUENCY PLOT
C                     ... HISTOGRAM
C                     ... HOMOSCEDASTICITY PLOT
C                     ... I PLOT
C                     INTERACTION PLOT
C                     LAG ... PLOT
C                     ... NORMALITY PLOT
C                     PERCENT POINT PLOT
C                     ... PERIODOGRAM
C                     PIE CHART
C                     PLOT
C                     ... PROBABILITY PLOT
C                     ... PPCC (PROBABILITY PLOT CORRELATION COEFFICIENT) PLOT
C                     ... ROOTOGRAM
C                     RUN SEQUENCE PLOT
C                     RUNS ... PLOT
C                     ... SPECTRAL PLOT
C                     3-D PLOT
C                     3-D ... FREQUENCY  PLOT
C                     3-D ... HISTOGRAM
C                     4-PLOT ... ANALYSIS (DONE IN MAIN)
C                     BAR CHART
C                     STEM AND LEAF DIAGRAM
C                     ... STATISTIC PLOT
C                     YOUDEN PLOT
C                     ... BIHISTOGRAM
C                     ERROR BAR PLOT    OCTOBER 1988
C                     FRACTAL PLOT      DECEMBER 1988
C                     POINCARE PLOT     DECEMBER 1988
C                     (REPLACED BY PHASE PLANE DIAGRAM  JULY 1989)
C                     JACKNIFE ... STATISTIC PLOT   JANUARY 1989
C                     BOOTSTRAP ... STATISTIC PLOT  JANUARY 1989
C                     DEX/DOE EXP DESIGN ... PLOT MAY       1989
C                     TAIL AREA PLOT                        1989
C                     NORMAL PLOT                 MAY       1990
C                     PHD PLOT (KER-CHAU LI)      OCTOBER   1991
C                     BLOCK  PLOT                 APRIL     1992.
C                     <STAT> BLOCK                JUNE      1992.
C                     SYMBOL PLOT                 AUGUST    1992.
C                     VECTOR PLOT                 AUGUST    1992
C                     ANDREWS PLOT                NOVEMBER  1992
C                     PARTIAL AUTOCORR. PLOT      FEBRUARY  1993
C                     Q ... CONTROL CHART         DECEMBER  1993
C                     CME (CONT. MEAN EXCEEDANCE) PLOT DECEMBER 1993
C                     CONDITIONAL ... PLOT        DECEMBER  1993
C                     ... COMOVEMENT  PLOT        OCTOBER   1997
C                     KAPLAN MEIER    PLOT        MAY       1998
C                     DUANE           PLOT        MAY       1998
C                     EMPIRICAL CDF   PLOT        MAY       1998
C                     EXPONENTIAL HAZARD PLOT     MAY       1998
C                     NORMAL      HAZARD PLOT     MAY       1998
C                     LOGNORMAL   HAZARD PLOT     MAY       1998
C                     WEIBULL     HAZARD PLOT     MAY       1998
C                     HOTELLING CONTROL CHART     MAY       1998
C                     SEASONAL SUBSERIES PLOT     FEBRUARY  1999
C                     SPREAD-LOCATION PLOT        AUGUST    1999
C                     TUKEY MEAN-DIFFERENCE PLOT  SEPTEMBER 1999
C                     INTERACTION   PLOT          OCTOBER   1999
C                     ... INTERACTION STAT PLOT   OCTOBER   1999
C                     CROSS TABULATE <STAT> PLOT  DECEMBER  1999
C                     DEX CONTOUR PLOT            JANUARY   2000
C                     YATES CUBE  PLOT            JANUARY   2000
C                     BAG PLOT                    JANUARY   2001
C                         (NOT IMPLEMENTED YET)
C                     KERNEL DENSITY PLOT         AUGUST    2001
C                     CONSENSUS MEAN PLOT         AUGUST    2001
C                     PARTIAL RESIDUAL PLOT       JUNE      2002
C                     PARTIAL REGRESSION PLOT     JUNE      2002
C                     PARTIAL LEVERAGE PLOT       JUNE      2002
C                     CCPR PLOT                   JUNE      2002
C                     INFLUENCE CURVE <STAT> PLOT JULY      2002
C                     SHIFT PLOT                  FEBRUARY  2003
C                     VIOLIN PLOT                 FEBRUARY  2003
C                     PARALLEL COORDINATES PLOT   MARCH     2003
C                     PEAKS OVER THRESHOLD PLOT   APRIL     2005
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --MARCH     1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C        ETC.
C     UPDATED         --AUGUST    1987.   BOX-COX STANDARDIZED EFFECTS PLOT
C     UPDATED         --JANUARY   1988.   (... STATISTIC PLOTS)
C     UPDATED         --JANUARY   1988.   (... CHARTS)
C     UPDATED         --FEBRUARY  1988.   PROFILE PLOT
C     UPDATED         --FEBRUARY  1988.   STAR PLOT
C     UPDATED         --AUGUST    1988.   CONTOUR PLOT
C     UPDATED         --AUGUST    1988.   PARETO PLOT
C     UPDATED         --SEPTEMBER 1988.  EQUATE PROPROTION PLOT TO ANOP PLOT
C     UPDATED         --SEPTEMBER 1988.  YOUDEN PLOT (= PLOT WITH 3 ARGS)
C     UPDATED         --SEPTEMBER 1988.  BIHISTOGRAM
C     UPDATED         --NOVEMBER  1988.  ERROR BAR PLOT
C     UPDATED         --DECEMBER  1988.  ISEED ARGUMENT--FRACTAL PLOT
C     UPDATED         --DECEMBER  1988.  POINCARE PLOT
C     UPDATED         --JANUARY   1989.  JACKNIFE ... STAT PLOTS
C     UPDATED         --JANUARY   1989.  BOOTSTRAP ... STAT PLOTS
C     UPDATED         --FEBRUARY  1989.  CONTINUE CHARACTER CONFLICT (ALAN)
C     UPDATED         --APRIL     1989.  SCATTER PLOT (= SYNONYM FOR PLOT)
C     UPDATED         --MAY       1989.  DEX/DOE ... PLOT
C     UPDATED         --MAY       1989.  TAIL AREA PLOT
C     UPDATED         --JULY      1989.  POINCARE PLOT TO PHASE PLANE DIAG
C     UPDATED         --MAY       1990.  NORMAL PLOT
C     UPDATED         --OCTOBER   1991.  PHD PLOT (NOT DONE YET)
C     UPDATED         --APRIL     1992.  BLOCK PLOT
C     UPDATED         --JUNE      1992.  <STAT> BLOCK PLOT
C     UPDATED         --AUGUST    1992.  VECTOR PLOT, SYMBOL PLOT
C     UPDATED         --NOVEMBER  1992.  ANDREWS PLOT
C     UPDATED         --FEBRUARY  1993.  PARTIAL AUTOCORRELATION PLOT
C     UPDATED         --JULY      1993.  ARGUMENTS TO FRACTAL PLOT
C     UPDATED         --AUGUST    1993.  CONFLICT WITH MEDIAN POLISH
C     UPDATED         --DECEMBER  1993.  ADD ARG IN CALL DPPP()
C     UPDATED         --DECEMBER  1993.  Q ... CONTROL CHART
C     UPDATED         --DECEMBER  1993.  CME PLOT
C     UPDATED         --DECEMBER  1993.  COND. ... EXCEEDANCE PLOT
C     UPDATED         --DECEMBER  1994.  AUGMENT DPPARE() ARG. LIST
C     UPDATED         --MARCH     1995.  ADD MAXNXT TO DPBLOC 
C     UPDATED         --MARCH     1996.  ADD IRHSTG TO DPHIST 
C     UPDATED         --OCTOBER   1997.  COMOVEMENT PLOT
C     UPDATED         --OCTOBER   1997.  AUTO COMOVEMENT PLOT
C     UPDATED         --MAY       1998.  KAPLAN MEIER PLOT
C     UPDATED         --MAY       1998.  DUANE PLOT
C     UPDATED         --MAY       1998.  EMPIRICAL CDF PLOT
C     UPDATED         --SEPTEMBER 1998.  HOTELLING CONTROL CHART
C     UPDATED         --FEBRUARY  1999.  SEASONAL SUBSERIES PLOT
C     UPDATED         --AUGUST    1999.  SPREAD-LOCATION PLOT
C     UPDATED         --SEPTEMBER 1999.  TUKEY MEAN-DIFFERENCE PLOT
C     UPDATED         --OCTOBER   1999.  INTERACTION PLOT
C     UPDATED         --OCTOBER   1999.  INTERACTION STATISTIC PLOT
C     UPDATED         --DECEMBER  1999.  IMPLEMENT SUB-REGIONS
C     UPDATED         --DECEMBER  1999.  SAVE SOME INTERNAL PARAMETERS
C                                        FOR ALL PLOTS
C     UPDATED         --DECEMBER  1999.  CROSS TABULATE PLOT
C     UPDATED         --JANUARY   2000.  DEX CONTOUR PLOT
C     UPDATED         --JANUARY   2001.  BAG PLOT
C     UPDATED         --AUGUST    2001.  KERNEL DENSITY PLOT
C     UPDATED         --AUGUST    2001.  CONSENSUS MEAN PLOT
C     UPDATED         --MARCH     2002.  ROBUSTNESS PLOT SYNONUM
C                                        FOR BLOCK PLOT
C     UPDATED         --JULY      2002.  INFLUENCE CURVE
C     UPDATED         --OCTOBER   2002.  CALL LIST TO CONSENUSE MEAN
C                                        PLOT
C     UPDATED         --FEBRUARY  2003.  SHIFT PLOT
C     UPDATED         --FEBRUARY  2003.  VIOLIN PLOT
C     UPDATED         --MARCH     2003.  PARALLEL COORDINATES PLOT
C     UPDATED         --SEPTEMBER 2003.  BCA <BOOTSTRAP/JACKINFE>
C     UPDATED         --MAY       2004.  KOLMOGOROV SMIRNOV PLOT AS
C                                        VARIANT OF PPCC PLOT
C     UPDATED         --SEPTEMBER 2004.  CALL LIST TO DPHIST
C     UPDATED         --APRIL     2005.  PEAKS OVER THRESHOLD PLOT
C     UPDATED         --MARCH     2006.  ADD IFORSW TO CONSENSUS MEAN
C                                        PLOT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASP2
      CHARACTER*4 ICAPSW
      CHARACTER*4 IFORSW
CCCCC CHARACTER*4 ICASSW
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 IDIREC
      CHARACTER*4 IWRITE
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
      CHARACTER*4 IRHSTG
      CHARACTER*4 IBCABT
      CHARACTER*4 IHSTCW
      CHARACTER*4 IASHWT
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOCO.INC'
      INCLUDE 'DPCOHO.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
CCCCC ICONT=IDEVCN(1)
CCCCC ICOLOR=IDEVCL(1)
CCCCC NUMHPP=IDEVPP(1,1)
CCCCC NUMVPP=IDEVPP(1,2)
C
      IF(IBUGGR.EQ.'OFF'.AND.ISUBRO.NE.'INGR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAINGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICONT,ICOLOR,NUMHPP,NUMVPP
   52 FORMAT('ICONT,ICOLOR,NUMHPP,NUMVPP = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGGR,IBUGG2,IBUGG3
   53 FORMAT('IBUGGR,IBUGG2,IBUGG3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGPL,IBUGP,IBUGP1,IBUGP2,IBUGP3
   54 FORMAT('IBUGPL,IBUGP,IBUGP1,IBUGP2,IBUGP3 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGCO,IBUGEV,IBUGQ,ISUBRO
   55 FORMAT('IBUGCO,IBUGEV,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU,MAXNPP,ISEED,IBOOSS
   57 FORMAT('IANGLU,MAXNPP,ISEED,IBOOSS = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)ICASPL
   58 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IAND1,IAND2
   59 FORMAT('IAND1,IAND2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFOUND,IERROR
   60 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IFENSW
   61 FORMAT('IFENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,75)MAXNPP
   75 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IX1TSC,IX2TSC,IY1TSC,IY2TSC
   81 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IX1TSV,IX2TSV,IY1TSV,IY2TSV
   82 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)ANOPL1,ANOPL2
   83 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
      IBCABT='OFF'
C
C               *******************************
C               **  TREAT THE BOX PLOT CASE  **
C               *******************************
C
      IF(ICOM.EQ.'BOX')GOTO100
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BOX')GOTO100
      GOTO199
C
  100 CONTINUE
      CALL DPBOX(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IFENSW,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  199 CONTINUE
C
C               **********************************
C               **  TREAT THE VIOLIN PLOT CASE  **
C               **********************************
C
      IF(ICOM.EQ.'VIOL')THEN
        CALL DPVIOL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              ICONT,IFENSW,IKDETY,IKDENP,PKDEWI,
     1              ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
C               ****************************************************
C               **  TREAT THE COMPLEX DEMODULATION ... PLOT CASE  **
C               ****************************************************
C
CCCCC IF(ICOM.EQ.'COMP')GOTO200
      IF(ICOM.EQ.'COMP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'DEMO')GOTO200
      GOTO299
C
  200 CONTINUE
      CALL DPCD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,DEMOFR,DEMODF,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  299 CONTINUE
C
C               ****************************************
C               **  TREAT THE ... CONTROL CHART CASE  **
C               ****************************************
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT                FEBRUARY 1989
CCCCC AND REPLACED BY THE SUCCEEDING LINE                 FEBRUARY 1989
CCCCC TO AVOID A CONFLICT WITH THE CONTINUE CHARACTER     FEBRUARY 1989
CCCCC IF(ICOM.EQ.'CONT')GOTO300
CCCCC ADD HOTELLING CONTROL CHART (= MULTIVARIATE CONTROL
CCCCC CHART)                                             SEPTEMBER 1998
CCCCC SUPPORT FOUR DISTINCT CASES FOR HOTELLING CONTROL  FEBRUARY 2003
CCCCC CHART:
CCCCC   1) PHASE I HOTELLING CONTROL CHART
CCCCC   2) PHASE I HOTELLING INDIVIDUAL CONTROL CHART
CCCCC   3) PHASE II HOTELLING CONTROL CHART
CCCCC   4) PHASE II HOTELLING INDIVIDUAL CONTROL CHART
CCCCC IF PHASE <I/II> OMITTED, ASSUME A PHASE I CHART.
C
      IF(ICOM.EQ.'CONT'.AND.ICOM2.NE.'INUE')GOTO300
C
      IF(ICOM.EQ.'PHAS')THEN
        IF(IHARG(1).EQ.'I'.OR.IHARG(1).EQ.'ONE'.OR.IHARG(1).EQ.'1')THEN
          CALL DPHTCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ELSEIF(IHARG(1).EQ.'II'.OR.IHARG(1).EQ.'TWO'.OR.
     1         IHARG(1).EQ.'2')THEN
          CALL DPHTCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICOM.EQ.'HOTE'.OR.
     1  (ICOM.EQ.'MULT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CONT'))THEN
        CALL DPHTCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1  ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO300
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO300
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO300
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CONT')GOTO300
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CHAR')GOTO300
      GOTO399
C
  300 CONTINUE
      CALL DPCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  399 CONTINUE
C
C               *******************************************
C               **  TREAT THE ... CORRELATION PLOT CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'AUTO')GOTO400
      IF(ICOM.EQ.'CROS')GOTO400
CCCCC THE FOLLOWING LINE WAS ADDED FEBRUARY 1993
      IF(ICOM.EQ.'PART')GOTO400
      GOTO499
C
  400 CONTINUE
      CALL DPCORR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  499 CONTINUE
C
C               *****************************************
C               **  TREAT THE ... FREQUENCY PLOT CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'FREQ')GOTO500
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FREQ')GOTO500
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'FREQ')GOTO500
      GOTO599
C
  500 CONTINUE
      CALL DPFREQ(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  599 CONTINUE
C
C               ************************************
C               **  TREAT THE ... HISTOGRAM CASE  **
C               ************************************
C
      IF(ICOM.EQ.'HIST' .OR. ICOM.EQ.'ASH ')GOTO600
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HIST')GOTO600
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'HIST')GOTO600
      GOTO699
C
  600 CONTINUE
      CALL DPHIST(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
CCCCC MARCH 1996.  ADD FOLLOWING LINE
     1IRHSTG,IHSTCW,IASHWT,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  699 CONTINUE
C
C               *****************************
C               **  TREAT THE I PLOT CASE  **
C               *****************************
C
      IF(ICOM.EQ.'I')GOTO700
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'I')GOTO700
      GOTO799
C
  700 CONTINUE
      CALL DPI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  799 CONTINUE
C
C               ***********************************
C               **  TREAT THE LAG ... PLOT CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'LAG')GOTO800
      GOTO899
C
  800 CONTINUE
      CALL DPLAG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
  899 CONTINUE
C
C               *****************************************
C               **  TREAT THE PERCENT POINT PLOT CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'PERC')GOTO1000
      GOTO1099
C
 1000 CONTINUE
      IF(ICOM2.EQ.'ENTI')GOTO1099
      IF(IHARG(1).EQ.'PLOT')GOTO1099
      IF(IHARG(1).EQ.'BEND'.AND.IHARG(2).EQ.'MIDV')GOTO1099
      CALL DPPERC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1099 CONTINUE
C
C               **************************************
C               **  TREAT THE ... PERIODOGRAM CASE  **
C               **************************************
C
      IF(ICOM.EQ.'PERI')GOTO1100
      IF(ICOM2.EQ.'PERI')GOTO1100
      IF(ICOM2.EQ.'SPER')GOTO1100
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PERI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      CALL DPPERI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1199 CONTINUE
C
C               ********************************
C               **  TREAT THE PIE CHART CASE  **
C               ********************************
C
      IF(ICOM.EQ.'PIE')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      CALL DPPIE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1299 CONTINUE
C
C               ************************************
C               **  TREAT THE PLOT CASE.          **
C               **  TREAT THE YOUDEN PLOT         **
C               **  AS A SPECIAL CASE OF PLOT     **
C               **  (PLOT WITH 3 ARGUMENTS).      **
C               **  TREAT THE SCATTER PLOT        **
C               **  AS A SYNONYM FOR PLOT     **
C               ************************************
C
      IF(ICOM.EQ.'YOUD')GOTO1300
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1989
      IF(ICOM.EQ.'SCAT')GOTO1300
      IF(ICOM.EQ.'PLOT')GOTO1310
      GOTO1399
C
 1300 CONTINUE
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGA2,IERROR)
      GOTO1310
 1310 CONTINUE
      IAND1=IAND2
      CALL DPPLOT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1WRITE(ICOUT,333)IFOUND,IERROR,IAND1,IAND2
  333 FORMAT('IFOUND,IERROR,IAND1,IAND2 = ',A4,2X,A4,2X,A4,2X,A4)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1CALL DPWRST('XXX','BUG ')
      IF(IFOUND.EQ.'YES')GOTO9000
CCCCC IF(IAND2.EQ.'YES')GOTO100
CCCCC IF(IAND2.EQ.'NO')GOTO9000
C
 1399 CONTINUE
C
C               *******************************************
C               **  TREAT THE ... PROBABILITY PLOT CASE  **
C               *******************************************
C
      IMAX=NUMARG-1
      IF(IMAX.LE.0)GOTO1499
      DO1410I=1,NUMARG
      IF(IHARG(I).EQ.'PROB')GOTO1400
 1410 CONTINUE
      GOTO1499
C
 1400 CONTINUE
      CALL DPPP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC THE FOLLOWING LINE WAS CHANGED    DECEMBER 1993
CCCCC1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1499 CONTINUE
C
C               ************************************
C               **  TREAT THE ... PPCC PLOT CASE  **
C               ************************************
C
      IF(ICOM.EQ.'PPCC')GOTO1500
      IMAX=NUMARG-1
      IF(IMAX.LE.0)GOTO1519
      DO1510I=1,NUMARG
      IF(IHARG(I).EQ.'PPCC')GOTO1500
 1510 CONTINUE
      GOTO1519
C
 1500 CONTINUE
      ICASP2='PPCC'
      CALL DPPPCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICASP2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1519 CONTINUE
C
      IMAX=NUMARG-2
      IF(IMAX.LE.0)GOTO1529
      DO1520I=1,NUMARG-2
      IF(IHARG(I).EQ.'KS  ' .AND. IHARG(I+1).EQ.'PLOT')GOTO1550
      IF(IHARG(I).EQ.'KOLM' .AND. IHARG(I+1).EQ.'SMIR' .AND.
     1   IHARG(I+2).EQ.'PLOT')GOTO1550
 1520 CONTINUE
      GOTO1529
C
 1550 CONTINUE
      ICASP2='KS  '
      CALL DPPPCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICASP2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1529 CONTINUE
C               ****************************************
C               **  TREAT THE RUN SEQUENCE PLOT CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'RUN'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'SEQU')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      CALL DPRUNS(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1699 CONTINUE
C
C               ************************************
C               **  TREAT THE RUNS ... PLOT CASE  **
C               ************************************
C
      IF(ICOM.EQ.'RUNS'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      CALL DPRUPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1799 CONTINUE
C
C               ****************************************
C               **  TREAT THE ... SPECTRAL PLOT CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'AUTO')GOTO1800
      IF(ICOM.EQ.'SPEC')GOTO1800
      IF(ICOM.EQ.'COSP')GOTO1800
      IF(ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'SPEC')GOTO1800
      IF(ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'SPEC')GOTO1800
      IF(ICOM.EQ.'COHE')GOTO1800
      IF(ICOM.EQ.'AMPL')GOTO1800
      IF(ICOM.EQ.'PHAS')GOTO1800
      IF(ICOM.EQ.'GAIN')GOTO1800
      IF(ICOM.EQ.'ARGA')GOTO1800
      GOTO1899
C
 1800 CONTINUE
      CALL DPSPEC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 1899 CONTINUE
C
C               *******************************
C               **  TREAT THE 3-D PLOT CASE  **
C               *******************************
C
      IF(ICOM.EQ.'3D')GOTO1900
      IF(ICOM.EQ.'3')GOTO1900
      IF(ICOM.EQ.'3DPL')GOTO1900
      GOTO1999
C
 1900 CONTINUE
      CALL DP3DPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1WRITE(ICOUT,1933)IFOUND,IERROR,IAND1,IAND2
 1933 FORMAT('IFOUND,IERROR,IAND1,IAND2 = ',A4,2X,A4,2X,A4,2X,A4)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1CALL DPWRST('XXX','BUG ')
      IF(IFOUND.EQ.'YES')GOTO9000
CCCCC IF(IAND2.EQ.'YES')GOTO100
CCCCC IF(IAND2.EQ.'NO')GOTO9000
C
 1999 CONTINUE
C
C               *********************************************
C               **  TREAT THE 3-D ... FREQUENCY PLOT CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'3D')GOTO2000
      IF(ICOM.EQ.'3')GOTO2000
      IF(ICOM.EQ.'3DPL')GOTO2000
      GOTO2099
C
 2000 CONTINUE
      CALL DP3DFR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2099 CONTINUE
C
C               ****************************************
C               **  TREAT THE 3-D ... HISTOGRAM CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'3D')GOTO2100
      IF(ICOM.EQ.'3')GOTO2100
      IF(ICOM.EQ.'3DPL')GOTO2100
      GOTO2199
C
 2100 CONTINUE
      CALL DP3DHI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2199 CONTINUE
C
C               ****************************************
C               **  TREAT THE BOX-COX NORMALITY PLOT  **
C               ****************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'BOX'.AND.
     1IHARG(1).EQ.'COX'.AND.IHARG(2).EQ.'NORM')GOTO2300
      GOTO2399
C
 2300 CONTINUE
      CALL DPBCNP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2399 CONTINUE
C
C               ***********************************************
C               **  TREAT THE BOX-COX HOMOSCEDASTICITY PLOT  **
C               ***********************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'BOX'.AND.
     1IHARG(1).EQ.'COX'.AND.IHARG(2).EQ.'HOMO')GOTO2400
      GOTO2499
C
 2400 CONTINUE
      CALL DPBCHP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2499 CONTINUE
C
C               ********************************
C               **  TREAT THE PROPORTION PLOT CASE  **
C               **  = THE ANOP PLOT CASE  **
C               ********************************
C
      IF(ICOM.EQ.'PROP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO2500
      IF(ICOM.EQ.'ANOP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO2500
      GOTO2599
C
 2500 CONTINUE
      CALL DPANPP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1ANOPL1,ANOPL2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2599 CONTINUE
C
C               ************************************
C               **  TREAT THE BAR PLOT CASE       **
C               ************************************
C
      IF(ICOM.EQ.'BAR'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')
     1GOTO2600
      IF(ICOM.EQ.'BAR'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')
     1GOTO2600
      GOTO2699
C
 2600 CONTINUE
      CALL DPBARP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2699 CONTINUE
C
C               *******************************
C               **  TREAT THE FFT PLOT CASE  **
C               *******************************
C
CCCCC IF(ICOM.EQ.'FFT'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')
CCCCC1GOTO2700
CCCCC GOTO2799
C
C2700 CONTINUE
CCCCC CALL DPFFTP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1IANGLU,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES')GOTO9000
C
C2799 CONTINUE
C
C               ************************************
C               **  TREAT THE ... ROOTOGRAM CASE  **
C               ************************************
C
      IF(ICOM.EQ.'ROOT')GOTO2800
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ROOT')GOTO2800
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'ROOT')GOTO2800
      GOTO2899
C
 2800 CONTINUE
      CALL DPROGR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2899 CONTINUE
C
C               ********************************************
C               **  TREAT THE STEM AND LEAF DIAGRAM CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'STEM')GOTO2900
      GOTO2999
C
 2900 CONTINUE
      CALL DPSTEM(IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 2999 CONTINUE
C
C               *****************************************************
C               **  TREAT THE ALLAN VARIANCE PLOT CASE             **
C               **  TREAT THE ALLAN STANDARD DEVIATION PLOT CASE   **
C               *****************************************************
C
      IF(ICOM.EQ.'ALLA')GOTO3100
      IF(ICOM.EQ.'AV')GOTO3100
      IF(ICOM.EQ.'ASD')GOTO3100
      IF(ICOM.EQ.'AS')GOTO3100
      GOTO3199
C
 3100 CONTINUE
      CALL DPALLA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 3199 CONTINUE
C
C               ****************************************************
C               **  TREAT THE COMPLEX REMODULATION PLOT CASE      **
C               ****************************************************
C
      IF(ICOM.EQ.'REMO')GOTO3300
      IF(ICOM.EQ.'COMP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'REMO')GOTO3300
      GOTO3399
C
 3300 CONTINUE
      CALL DPREMO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,DEMOFR,DEMODF,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 3399 CONTINUE
C
C               ************************************
C               **  TREAT THE SYMMETRY PLOT CASE  **
C               ************************************
C
      IF(ICOM.EQ.'SYMM')GOTO4100
      GOTO4199
C
 4100 CONTINUE
      CALL DPSYMM(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 4199 CONTINUE
C
C               ********************************************
C               **  TREAT THE BOX-COX SYMMETRY PLOT CASE  **
C               ********************************************
C
CNNNN IF(NUMARG.GE.2.AND.ICOM.EQ.'BOX'.AND.
CNNNN1IHARG(1).EQ.'COX'.AND.IHARG(2).EQ.'SYMM')GOTO4200
CNNNN GOTO4299
C
C4200 CONTINUE
CNNNN CALL DPBCSP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CNNNN1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
CNNNN IF(IFOUND.EQ.'YES')GOTO9000
C
C4299 CONTINUE
C
C               *********************************************
C               **  TREAT THE QUANTILE-QUANTILE PLOT CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'QUAN')GOTO4300
      GOTO4399
 
 4300 CONTINUE
      CALL DPQUAN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
 
 4399 CONTINUE
C
C               *********************************************
C               **  TREAT THE BAG               PLOT CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'BAG ')THEN
        CALL DPBAGP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              ISEED,MAXNPP,
     1              IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
C               ********************************************
C               **  TREAT THE HOMOSCEDASTICITY PLOT CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'HOMO')GOTO4400
      GOTO4499
C
 4400 CONTINUE
      CALL DPHOMO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 4499 CONTINUE
C
C               ***************************************
C               **  TREAT THE BIHISTOGRAM PLOT CASE  **
C               ***************************************
C
      IF(ICOM.EQ.'BIHI')GOTO4600
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BIHI')GOTO4600
      GOTO4699
C
 4600 CONTINUE
      CALL DPBIHI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
     1TEMP,TEMP2,XTEMP1,XTEMP2,
CCCCC MARCH 1996.  ADD FOLLOWING LINE.
     1IRHSTG,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 4699 CONTINUE
C
C               ************************************
C               **  TREAT THE YOUDEN PLOT CASE    **
C               ************************************
C
CNNNN IF(ICOM.EQ.'YOUDEN')GOTO4700
CNNNN GOTO4799
C
C4700 CONTINUE
CNNNN CALL DPYOUD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CNNNN1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
CNNNN IF(IFOUND.EQ.'YES')GOTO9000
C
C4799 CONTINUE
C
C               ************************************
C               **  TREAT THE GANOVA PLOT CASE    **
C               ************************************
C
CNNNN IF(ICOM.EQ.'GANO'.AND.ICOM2.EQ.'VA  ')GOTO4800
CNNNN GOTO4899
C
C4800 CONTINUE
CNNNN CALL DPGANO(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CNNNN1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
CNNNN IF(IFOUND.EQ.'YES')GOTO9000
C
C4899 CONTINUE
C
C               *************************************
C               **  TREAT THE DRAFTSMAN PLOT CASE  **
C               *************************************
C
CNNNN IF(ICOM.EQ.'DRSF')GOTO6100
CNNNN GOTO6199
C
C6100 CONTINUE
CNNNN CALL DPDRAF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CNNNN1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
CNNNN IF(IFOUND.EQ.'YES')GOTO9000
C
C6199 CONTINUE
C
C               ***********************************
C               **  TREAT THE CONTOUR PLOT CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'CONT'.AND.IHARG(1).EQ.'PLOT')GOTO6200
      GOTO6299
C
 6200 CONTINUE
      CALL DPCOPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1WRITE(ICOUT,6233)IFOUND,IERROR,IAND1,IAND2
 6233 FORMAT('IFOUND,IERROR,IAND1,IAND2 = ',A4,2X,A4,2X,A4,2X,A4)
      IF(IBUGGR.EQ.'ON'.OR.ISUBRO.EQ.'INGR')
     1CALL DPWRST('XXX','BUG ')
      IF(IFOUND.EQ.'YES')GOTO9000
CCCCC IF(IAND2.EQ.'YES')GOTO100
CCCCC IF(IAND2.EQ.'NO')GOTO9000
C
 6299 CONTINUE
C
C               ***********************************************
C               **  TREAT THE BOX-COX LINEARITY PLOT CASE  **
C               ***********************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'BOX'.AND.
     1IHARG(1).EQ.'COX'.AND.IHARG(2).EQ.'LINE')GOTO6300
      GOTO6399
C
 6300 CONTINUE
      CALL DPBCCP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6399 CONTINUE
C
C               *********************************************************
C               **  TREAT THE BOX-COX  STANDARDIZED EFFECTS PLOT CASE  **
C               *********************************************************
C
      IF(NUMARG.GE.3.AND.ICOM.EQ.'BOX'.AND.
     1IHARG(1).EQ.'COX'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'EFFE')GOTO6400
      GOTO6499
C
 6400 CONTINUE
CCCCC CALL DPBCSE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES')GOTO9000
C
 6499 CONTINUE
C
C               ************************************
C               **  TREAT THE WEIBULL  PLOT CASE  **
C               ************************************
C
      IF(ICOM.EQ.'WEIB')GOTO6500
      GOTO6599
C
 6500 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO6510
      GOTO6599
 6510 CONTINUE
      CALL DPWEIB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6599 CONTINUE
C
CCCCCC ADD FOLLOWING COMMAND DECEMBER 1999.
C               ****************************************************
C               **  TREAT THE CROSS TABULATE <STATISTIC> PLOT CASE**
C               ****************************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'TABU')THEN
        DO16602I=2,NUMARG
          IF(IHARG(I).EQ.'PLOT')GOTO16600
16602   CONTINUE
        GOTO16699
C
16600   CONTINUE
        CALL DPCRPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1    TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1    ISEED,
     1    ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
16699 CONTINUE
C
C               ****************************************
C               **  TREAT THE ... STATISTIC PLOT CASE **
C               ****************************************
C
      DO6602I=1,NUMARG
        IF(IHARG(I).EQ.'INTE'.AND.IHARG2(I).EQ.'RACT')GOTO6699
        IF(IHARG(I).EQ.'INFL'.AND.IHARG2(I).EQ.'UENC')GOTO6699
 6602 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO6600
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PLOT')GOTO6600
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PLOT')GOTO6600
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PLOT')GOTO6600
      IF(NUMARG.GE.5.AND.IHARG(5).EQ.'PLOT')GOTO6600
      IF(NUMARG.GE.6.AND.IHARG(6).EQ.'PLOT')GOTO6600
      GOTO6699
C
 6600 CONTINUE
      CALL DPSP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
CCCCC JULY 2002. ADD ISEED FOR HODGES-LEHMAN PLOT
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6699 CONTINUE
C
C               ***********************************
C               **  TREAT THE PROFILE PLOT CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'PROF')GOTO6700
      GOTO6799
C
 6700 CONTINUE
      CALL DPPROF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6799 CONTINUE
C
C               ***********************************
C               **  TREAT THE STAR    PLOT CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'STAR')GOTO6800
      GOTO6899
C
 6800 CONTINUE
      CALL DPSTAR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6899 CONTINUE
C
C               **********************************
C               **  TREAT THE PARETO PLOT CASE  **
C               **********************************
C
      IF(ICOM.EQ.'PARE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PLOT')GOTO6900
      GOTO6999
C
 6900 CONTINUE
      IDIREC='DECR'
CCCCC THE FOLLOWING ARGUMENT LIST WAS AUGMENTED   DECEMBER 1994
      CALL DPPARE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1ICONT,IDIREC,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
     1ICONT,IDIREC,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 6999 CONTINUE
C
C               *************************************
C               **  TREAT THE ERROR BAR PLOT CASE  **
C               *************************************
C
      IF(ICOM.EQ.'ERRO')GOTO7100
      GOTO7199
C
 7100 CONTINUE
      IF(IHARG(1).EQ.'PROB' .AND. IHARG(2).EQ.'PLOT')GOTO7199
      IF(IHARG(1).EQ.'PPCC' .AND. IHARG(2).EQ.'PLOT')GOTO7199
      IF(IHARG(1).EQ.'KOLM' .AND. IHARG(2).EQ.'SMIR')GOTO7199
      IF(IHARG(1).EQ.'CHI ' .AND. IHARG(2).EQ.'SQUA')GOTO7199
      IF(IHARG(1).EQ.'CHIS' .AND. IHARG(2).EQ.'GOOD')GOTO7199
      CALL DPERBA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ICONT,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7199 CONTINUE
C
C               *************************************
C               **  TREAT THE FRACTAL PLOT CASE    **
C               *************************************
C
      IF(ICOM.EQ.'FRAC')GOTO7200
      GOTO7299
C
 7200 CONTINUE
CCCCC JULY 1993.  ADD FOLLOWING 2 LINES
      IF(IHARG(1).EQ.'ITER')GOTO7299
      IF(IHARG(1).EQ.'TYPE')GOTO7299
      CALL DPFRAC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ICONT,
     1IANGLU,ISEED,
CCCCC JULY 1993.  ADD FOLLOWING LINE
     1IFRAIT,IFRATY,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7299 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS CHANGED FROM POINCARE PLOT   JULY 1989
CCCCC TO PHASE PLANE DIAGRAM                                 JULY 1989
C               ******************************************
C               **  TREAT THE PHASE PLANE DIAGRAM CASE  **
C               ******************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'PHAS'.AND.
     1   IHARG(1).EQ.'PLAN'.AND.IHARG(2).EQ.'DIAG')GOTO7300
      IF(NUMARG.GE.2.AND.ICOM.EQ.'PHAS'.AND.
     1   IHARG(1).EQ.'PLAN'.AND.IHARG(2).EQ.'PLOT')GOTO7300
      GOTO7399
C
 7300 CONTINUE
      CALL DPPPD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7399 CONTINUE
C
C               **************************************************
C               **  TREAT THE JACKNIFE  ... STATISTIC PLOT CASE **
C               **  AND   THE BOOTSTRAP ... STATISTIC PLOT CASE **
C               **************************************************
C
CCCCC SEPTEMBER 2003: ADD BCA BOOTSTRAP/JACKNIFE
C
      IF(ICOM.EQ.'JACK')GOTO7400
      IF(ICOM.EQ.'BOOT')GOTO7400
      IF(ICOM.EQ.'BCA'.AND.
     1  (IHARG(1).EQ.'BOOT'.OR.IHARG(1).EQ.'JACK'))GOTO7400
      GOTO7499
C
 7400 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FIT')GOTO7499
C
      IF(ICOM.EQ.'BCA')THEN
        ICOM=IHARG(1)
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IBCABT='ON'
      ENDIF
C
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PLOT')GOTO7410
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PLOT')GOTO7410
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PLOT')GOTO7410
      IF(NUMARG.GE.5.AND.IHARG(5).EQ.'PLOT')GOTO7410
      IF(NUMARG.GE.6.AND.IHARG(6).EQ.'PLOT')GOTO7410
      IF(NUMARG.GE.7.AND.IHARG(7).EQ.'PLOT')GOTO7410
      GOTO7499
 7410 CONTINUE
      CALL DPJBSP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBOOSS,ISEED,IBCABT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7499 CONTINUE
C
C               ****************************************
C               **  TREAT THE DEX CONTOUR PLOT CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'DEX'.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'CONT'.AND.
     1   IHARG(2).EQ.'PLOT')THEN
        CALL DPDCNT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
C               ****************************************
C               **  TREAT THE YATES CUBE  PLOT CASE   **
C               ****************************************
C
      IF((ICOM.EQ.'DEX'.OR.ICOM.EQ.'YATE').AND.NUMARG.GE.2.AND.
     1   IHARG(1).EQ.'CUBE'.AND.IHARG(2).EQ.'PLOT')THEN
        CALL DPYACB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
C               ****************************************
C               **  TREAT THE DEX/DOE ... PLOT CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'DEX')GOTO7500
      IF(ICOM.EQ.'DEXP')GOTO7500
      IF(ICOM.EQ.'DOE')GOTO7500
      IF(ICOM.EQ.'DOX')GOTO7500
      GOTO7599
C
 7500 CONTINUE
      CALL DPDEXP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7599 CONTINUE
C
C               ****************************************
C               **  TREAT THE TAIL AREA PLOT CASE     **
C               **  (A SYNONYM IS SURVIVAL PLOT)      **
C               **  (MAY 1989)                        **
C               ****************************************
C
      IF(ICOM.EQ.'TAIL')GOTO7600
      IF(ICOM.EQ.'SURV')GOTO7600
      GOTO7699
C
 7600 CONTINUE
      CALL DPTAIL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7699 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1998
C               **************************************************
C               **  TREAT THE <NORMAL/LOGNORMAL/WEIBULL/HAZARD> **
C               **  PLOT CASE                                   **
C               **************************************************
C
      IF(ICOM.EQ.'NORM'.OR.ICOM.EQ.'LOGN'.OR.ICOM.EQ.'EXPO'.OR.
     1  ICOM.EQ.'WEIB'.OR.ICOM.EQ.'GUMB')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HAZA'.AND.
     1     IHARG(2).EQ.'PLOT')THEN
          CALL DPHAZA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IANGLU,MAXNPP,
     1                IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
      IF(ICOM.EQ.'EXTR'.AND.IHARG(1).EQ.'VALU')THEN
        IF(NUMARG.GE.3.AND.IHARG(2).EQ.'HAZA'.AND.
     1     IHARG(3).EQ.'PLOT')THEN
          CALL DPHAZA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IANGLU,MAXNPP,
     1                IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1990
C               ************************************
C               **  TREAT THE NORMAL   PLOT CASE  **
C               ************************************
C
      IF(ICOM.EQ.'NORM')GOTO7700
      GOTO7799
C
 7700 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO7710
      GOTO7799
 7710 CONTINUE
      CALL DPNORM(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7799 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    APRIL 1992 (JJF)
C               *********************************
C               **  TREAT THE BLOCK PLOT CASE  **
C               *********************************
C
CCCCC THE FOLLOWING 3 LINES WERE COMMENTED OUT   JUNE 1992  JJF
CCCCC TO ACCOMODATE THE <STAT> BLOCK PLOTS   JUNE 1992   JJF
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'BLOC'.AND.
CCCCC1IHARG(1).EQ.'PLOT')GOTO7800
CCCCC GOTO7899
C
CCCCC THE FOLLOWING 10 LINES WERE ADDED TO AVOID     AUGUST 1993
CCCCC A CONFLICT WITH   MEIDAN POLISH   COMMAND      AUGUST 1993
      IF(ICOM.EQ.'ROBU'.AND.IHARG(1).EQ.'SMOO')GOTO7899
      IF(NUMARG.GE.1)THEN
         IF((ICOM.EQ.'BLOC'.OR.ICOM.EQ.'ROBU').AND.
     1      IHARG(1).EQ.'PLOT')GOTO7800
      ENDIF
      IF(NUMARG.GE.2)THEN
         IF((IHARG(1).EQ.'BLOC'.OR.IHARG(1).EQ.'ROBU').AND.
     1     IHARG(2).EQ.'PLOT')GOTO7800
      ENDIF
      IF(NUMARG.GE.3)THEN
         IF((IHARG(2).EQ.'BLOC'.OR.IHARG(2).EQ.'ROBU').AND.
     1     IHARG(3).EQ.'PLOT')GOTO7800
      ENDIF
CCCCC FOLLOWING 3 LINES ADDED MARCH 1995.
      IF(NUMARG.GE.4)THEN
         IF((IHARG(3).EQ.'BLOC'.OR.IHARG(3).EQ.'ROBU').AND.
     1      IHARG(4).EQ.'PLOT')GOTO7800
      ENDIF
      GOTO7899
C
 7800 CONTINUE
CCCCC MARCH 1995.  ADD MAXNXT TO ARGUMENT LIST.
      CALL DPBLOC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1BARHEF,BARWEF,
     1BARHEF,BARWEF,MAXNXT,
     1ISEED,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7899 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1991 (JJF)
C               *********************************
C               **  TREAT THE PHD PLOT CASE    **
C               *********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'PHD'.AND.
     1IHARG(1).EQ.'PLOT')GOTO7900
      GOTO7999
C
 7900 CONTINUE
CCCCC CALL DPPHDP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
CCCCC1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 7999 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    AUGUST 1992 (ALAN)
C               *********************************
C               **  TREAT THE VECTOR PLOT CASE **
C               *********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'VECT'.AND.
     1IHARG(1).EQ.'PLOT')GOTO8100
      GOTO8199
C
 8100 CONTINUE
      CALL DPVECT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IVCFMT,IVCARR,IANGLU,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8199 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    AUGUST 1992 (ALAN)
C               *********************************
C               **  TREAT THE SYMBOL PLOT CASE **
C               *********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SYMB'.AND.
     1IHARG(1).EQ.'PLOT')GOTO8200
      GOTO8299
C
 8200 CONTINUE
      CALL DPPLSY(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8299 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    NOVEMBER 1992 (ALAN)
C               **********************************
C               **  TREAT THE ANDREWS PLOT CASE **
C               **********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'ANDR'.AND.
     1IHARG(1).EQ.'PLOT')GOTO8300
      GOTO8399
C
 8300 CONTINUE
CCCCC PANINC=0.1
      CALL DPANDR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,ANDINC,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8399 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    MARCH 2003 (ALAN)
C               ***********************************************
C               **  TREAT THE PARALLEL COORDINATES PLOT CASE **
C               ***********************************************
C
      IF(NUMARG.GE.2.AND.ICOM.EQ.'PARA'.AND.
     1IHARG(1).EQ.'COOR'.AND.IHARG(2).EQ.'PLOT')THEN
        CALL DPPCPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ELSEIF(NUMARG.GE.3.AND.ICOM.EQ.'GROU'.AND.
     1       IHARG(1).EQ.'PARA'.AND. IHARG(2).EQ.'COOR'.AND.
     1       IHARG(3).EQ.'PLOT')THEN
        CALL DPPCPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED      DECEMBER 1993
C               ******************************************
C               **  TREAT THE Q ... CONTROL CHART CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'Q')GOTO8400
      GOTO8499
C
 8400 CONTINUE
      CALL DPQCC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1ICONT,IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8499 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED      DECEMBER 1993
C               ************************************************
C               **  TREAT THE CME PLOT CASE                   **
C               **  TREAT THE COND. ... EXCEEDANCE PLOT CASE  **
C               ************************************************
C
C  MAY 1998.  CHECK FOR CONFLICT WITH "CME ESTIMATE" OR 
C             "CME GENERALIZED PARETO".
      IF(ICOM.EQ.'CME')GOTO8500
      IF(ICOM.EQ.'COND')GOTO8500
      IF(ICOM.EQ.'YANG')GOTO8500
      IF(ICOM.EQ.'LIFE')GOTO8500
      IF(ICOM.EQ.'MEAN')GOTO8500
      GOTO8599
C
 8500 CONTINUE
      IF(NUMARG.GE.1.AND.(IHARG(1).EQ.'ESTI'.OR.IHARG(1).EQ.'GENE'))
     1GOTO8599
      CALL DPCME(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8599 CONTINUE
C
C               *******************************************
C               **  TREAT THE ... COMOVEMENT  PLOT CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'AUTO')GOTO8600
      IF(ICOM.EQ.'CROS')GOTO8600
      IF(ICOM.EQ.'COMO')GOTO8600
      GOTO8699
C
 8600 CONTINUE
      CALL DPCOMV(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8699 CONTINUE
C
C               ****************************************
C               **  TREAT THE KAPLAN MEIER PLOT CASE  **
C               **  (MAY 1998)                        **
C               ****************************************
C
      IF(ICOM.EQ.'KAPL')GOTO8700
      IF(ICOM.EQ.'MODI')GOTO8700
      GOTO8799
C
 8700 CONTINUE
      CALL DPKAPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8799 CONTINUE
C
C               ****************************************
C               **  TREAT THE DUANE        PLOT CASE  **
C               **  (MAY 1998)                        **
C               ****************************************
C
      IF(ICOM.EQ.'DUAN')GOTO8800
      GOTO8899
C
 8800 CONTINUE
      CALL DPDUAN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8899 CONTINUE
C
C               ****************************************
C               **  TREAT THE EMPIRICAL CDF PLOT CASE **
C               **  (MAY 1998)                        **
C               ****************************************
C
      IF(ICOM.EQ.'EMPI')GOTO8900
      IF(ICOM.EQ.'ECDF')GOTO8900
      GOTO8999
C
 8900 CONTINUE
      CALL DPECDF(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 8999 CONTINUE
C
C               *********************************************
C               **  TREAT THE SEASONAL SUBSERIES PLOT CASE **
C               **  (FEBRUARY 1999)                        **
C               *********************************************
C
      IF(ICOM.EQ.'SEAS')GOTO9200
      GOTO9299
C
 9200 CONTINUE
      CALL DPSESB(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,ISUBRO,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 9299 CONTINUE
C
C               *********************************************
C               **  TREAT THE SPREAD-LOCATION    PLOT CASE **
C               **  (AUGUST   1999)                        **
C               *********************************************
C
      IF(ICOM.EQ.'SPRE')GOTO9300
      GOTO9399
C
 9300 CONTINUE
      CALL DPSLOC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 9399 CONTINUE
C
C               ************************************************
C               **  TREAT THE TUKEY MEAN-DIFFERENCE PLOT CASE **
C               ************************************************
C
      IF(ICOM.EQ.'TUKE'.AND.IHARG(1).NE.'LAMB')GOTO9400
      GOTO9499
 
 9400 CONTINUE
      CALL DPTUMD(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 9499 CONTINUE
C
C               ************************************************
C               **  TREAT THE SHIFT                 PLOT CASE **
C               ************************************************
C
      IF(ICOM.EQ.'SHIF')THEN
        CALL DPSHPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1              IANGLU,MAXNPP,
     1              IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES' .OR. IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C               ************************************************
C               **  TREAT THE INTERACTION           PLOT CASE **
C               ************************************************
C
      IF(ICOM.EQ.'INTE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PLOT')GOTO9500
      GOTO9599
C 
 9500 CONTINUE
      ISHIFT=1
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
      CALL DPINPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1MAXNPP,
     1IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C 
 9599 CONTINUE
C
C               ****************************************************
C               **  TREAT THE ... STATISTIC INTERACTION PLOT CASE **
C               ****************************************************
C
      IF(NUMARG.LT.2)GOTO9699
      DO9602I=1,NUMARG-1
        IF(IHARG(I).EQ.'INTE'.AND.IHARG(I+1).EQ.'PLOT')GOTO9600
 9602 CONTINUE
      IF(NUMARG.LT.3)GOTO9699
      DO9604I=1,NUMARG-2
        IF(IHARG(I).EQ.'INTE'.AND.IHARG(I+1).EQ.'STAT'.AND.
     1     IHARG(I+2).EQ.'PLOT')GOTO9600
 9604 CONTINUE
      GOTO9699
C
 9600 CONTINUE
      CALL DPISP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')GOTO9000
C
 9699 CONTINUE
C
C               *******************************************
C               **  TREAT THE KERNEL DENSITY PLOT  CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'KERN' .OR. ICOM.EQ.'DENS')THEN
        CALL DPKDEN(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1  IKDENP,PKDEWI,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES')GOTO9000
      ENDIF
C
C               *******************************************
C               **  TREAT THE CONSENSUS MEAN PLOT  CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'CONS')THEN
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'PLOT')THEN
          CALL DPCMPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                ICAPSW,ICAPTY,
     1                IFORSW,
     1                ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               *********************************************
C               **  TREAT THE PARTIAL REGRESSION PLOT CASE **
C               **  TREAT THE PARTIAL RESIDUAL   PLOT CASE **
C               **  TREAT THE PARTIAL LEVERAGE   PLOT CASE **
C               *********************************************
C
      IF(ICOM.EQ.'PART')THEN
        IF(NUMARG.GE.2.AND.
     1    (IHARG(1).EQ.'REGR'.AND.IHARG(2).EQ.'PLOT') .OR.
     1    (IHARG(1).EQ.'RESI'.AND.IHARG(2).EQ.'PLOT') .OR.
     1    (IHARG(1).EQ.'LEVE'.AND.IHARG(2).EQ.'PLOT'))THEN
          ICASPL='PREG'
          CALL DPPREG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICOM.EQ.'ADDE')THEN
        ICASPL='PREG'
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'PLOT')THEN
          CALL DPPREG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICOM.EQ.'COMP')THEN
        ICASPL='PREG'
        IF(NUMARG.GE.3.AND.
     1    IHARG(1).EQ.'PLUS'.AND.IHARG(2).EQ.'RESI'.AND.
     1    IHARG(3).EQ.'PLOT')THEN
          CALL DPPREG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICOM.EQ.'CCPR')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
          ICASPL='CCPR'
          CALL DPPREG(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               *****************************************
C               **  TREAT THE ... INFLUENCE CURVE CASE **
C               *****************************************
C
      IF(NUMARG.GE.2)THEN
        DO9710I=1,NUMARG-1
          IF(IHARG(I).EQ.'INFL' .AND. IHARG(I+1).EQ.'CURV')THEN
            CALL DPINCU(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1           TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1           ISEED,
     1           ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
            IF(IFOUND.EQ.'YES')GOTO9000
            GOTO9719
          ENDIF
 9710   CONTINUE
      ENDIF
 9719 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED      APRIL    2005
C               ************************************************
C               **  TREAT THE PEAKS OVER THRESHOLD PLOT  CASE **
C               **            POT                  PLOT       **
C               ************************************************
C
      IF(ICOM.EQ.'PEAK')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'OVER'.AND.
     1     IHARG(2).EQ.'THRE'.AND.IHARG(3).EQ.'PLOT')THEN
          CALL DPPOTP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBOOSS,ISEED,
     1                ICAPSW,ICAPTY,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ELSEIF(ICOM.EQ.'POT ')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
          CALL DPPOTP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1                IBOOSS,ISEED,
     1                ICAPSW,ICAPTY,
     1                IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C
C               *******************************************
C               **  END OF SEARCH FOR GRAPHICS COMMANDS  **
C               *******************************************
 8000 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
      GOTO9001
C
C               *******************************************
C               **  STEP 90A--                           **
C               **  DO THE FOLLOWING FOR ALL PLOTS:      **
C               **  1) SAVE SOME INTERNAL PARAMETERS     **
C               **  2) IMPLEMENT SUB-REGIONS             **
C               *******************************************
C
 9000 CONTINUE
      IF(IFOUND.EQ.'NO')GOTO9001
      IF(IERROR.EQ.'YES')GOTO9001
      IF(NPLOTP.LT.1)GOTO9001
      IF(ICASPL(1:2).EQ.'3D')GOTO9001
C
C  FIND PLOT MIN AND MAX AND CORRESPONDING INDEX AND SAVE AS
C  INTERNAL PARAMETERS.
C
      AYMIN=CPUMAX
      AYMAX=CPUMIN
      AXMIN=CPUMAX
      AXMAX=CPUMIN
      IYMIN=0
      IYMAX=0
      IXMIN=0
      IXMAX=0
      DO10001I=1,NPLOTP
        IF(Y(I).LT.AYMIN)THEN
          AYMIN=Y(I)
          IYMIN=I
        ENDIF
        IF(Y(I).GT.AYMAX)THEN
          AYMAX=Y(I)
          IYMAX=I
        ENDIF
        IF(X(I).LT.AXMIN)THEN
          AXMIN=X(I)
          IXMIN=I
        ENDIF
        IF(X(I).GT.AXMAX)THEN
          AXMAX=X(I)
          IXMAX=I
        ENDIF
10001 CONTINUE
      ISUBN0='INGR'
      IH='PLOT'
      IH2='YMAX'
      VALUE0=AYMAX
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='YMAX'
      IH2='INDE'
      VALUE0=REAL(IYMAX)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='PLOT'
      IH2='YMIN'
      VALUE0=AYMIN
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='YMIN'
      IH2='INDE'
      VALUE0=REAL(IYMIN)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='PLOT'
      IH2='XMAX'
      VALUE0=AXMAX
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='XMAX'
      IH2='INDE'
      VALUE0=REAL(IXMAX)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='PLOT'
      IH2='XMIN'
      VALUE0=AXMIN
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='XMIN'
      IH2='INDE'
      VALUE0=REAL(IXMIN)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C  FIND CORRELATION OF PLOT POINTS.  FIND 2 CORRELATIIONS:
C  ONE WITH ALL POINTS, ONE WITH TAGPLO=1.
C
      IWRITE='OFF'
      CALL CORR(Y,X,NPLOTP,IWRITE,ACORR,IBUGG3,IERROR)
      IH='PLOT'
      IH2='CORR'
      VALUE0=ACORR
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      J=0
      DO10101I=1,NPLOTP
        IF(D(I).EQ.1.0)THEN
          J=J+1
          TEMP(J)=Y(I)
          TEMP2(J)=X(I)
        ENDIF
10101 CONTINUE
      ACORR=0.0
      IF(J.GE.1)CALL CORR(TEMP,TEMP2,J,IWRITE,ACORR,IBUGG3,IERROR)
      IH='PLOT'
      IH2='COR1'
      VALUE0=ACORR
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C  IMPLEMENT SUB-REGIONS
C
      NUMSBR=0
      DO10200I=MAXSUB,1,-1
        IF(ISUBSW(I).EQ.'ON')THEN
          NUMSBR=NUMSBR+1
          IF(NPLOTP+5.GT.MAXPOP)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,10205)
10205       FORMAT('***** FROM MAINGR--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,10208)I
10208       FORMAT('      UNABLE TO IMPLEMENT SUB-REGION ',I5)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,10212)MAXPOP
10212       FORMAT('      THE NUMBER OF PLOT POINTS WOULD EXCEED ',
     1             'MAXIMUM OF ',I8,'.')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,10214)NPLOTP
10214       FORMAT('      THE CURRENT NUMBER OF PLOT POINTS = ',I8)
            CALL DPWRST('XXX','BUG ')
            GOTO10299
          ELSE
            DO10220II=NPLOTP,1,-1
              X(II+5)=X(II)
              Y(II+5)=Y(II)
              X3D(II+5)=X3D(II)
              DSIZE(II+5)=DSIZE(II)
              DSYMB(II+5)=DSYMB(II)
              DCOLOR(II+5)=DCOLOR(II)
              DFILL(II+5)=DFILL(II)
              D(II+5)=D(II)+1.0
10220       CONTINUE
            NPLOTP=NPLOTP+5
            X(1)=ASUBXL(I)
            IF(X(1).EQ.CPUMIN)X(1)=AXMIN
            X(2)=ASUBXU(I)
            IF(X(2).EQ.CPUMAX)X(2)=AXMAX
            X(3)=ASUBXU(I)
            IF(X(3).EQ.CPUMAX)X(3)=AXMAX
            X(4)=ASUBXL(I)
            IF(X(4).EQ.CPUMIN)X(4)=AXMIN
            Y(1)=ASUBYL(I)
            IF(Y(1).EQ.CPUMIN)Y(1)=AYMIN
            Y(2)=ASUBYL(I)
            IF(Y(2).EQ.CPUMIN)Y(2)=AYMIN
            Y(3)=ASUBYU(I)
            IF(Y(3).EQ.CPUMAX)Y(3)=AYMAX
            Y(4)=ASUBYU(I)
            IF(Y(4).EQ.CPUMAX)Y(4)=AYMAX
            X(5)=X(1)
            Y(5)=Y(1)
            DO10225JJ=1,5
              X3D(JJ)=1.0
              DSIZE(JJ)=1.0
              DSYMB(JJ)=1.0
              DCOLOR(JJ)=1.0
              DFILL(JJ)=1.0
              D(JJ)=1.0
10225       CONTINUE
          ENDIF
        ENDIF
10200 CONTINUE
      NACC=0
      NREJ=0
      NTOT=0
      IF(NUMSBR.GT.0)THEN
        NSTRT=NUMSBR*4+1
        IF(NSTRT.GT.NPLOTP)GOTO10299
        NTOT=0
        NACC=0
        NREJ=0
        XLOW=X(1)
        XHIGH=X(2)
        YLOW=Y(1)
        YHIGH=Y(4)
        DO10260I=NSTRT,NPLOTP
          NTOT=NTOT+1
          XPNT=X(I)
          YPNT=Y(I)
          IF(
     1      (XPNT.LT.XLOW.OR. XPNT.GT.XHIGH) .OR.
     1      (YPNT.LT.YLOW.OR.YPNT.GT.YHIGH)
     1       )THEN
            NREJ=NREJ+1
          ELSE
            NACC=NACC+1
          ENDIF
10260   CONTINUE
      ENDIF
10299 CONTINUE
      IH='NACC'
      IH2='EPT '
      VALUE0=REAL(NACC)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='NREJ'
      IH2='ECT '
      VALUE0=REAL(NREJ)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
      IH='NTOT'
      IH2='AL  '
      VALUE0=REAL(NTOT)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9001 CONTINUE
      IF(IBUGGR.EQ.'OFF'.AND.ISUBRO.NE.'INGR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAINGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICONT,ICOLOR,NUMHPP,NUMVPP
 9012 FORMAT('ICONT,ICOLOR,NUMHPP,NUMVPP = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGGR,IBUGG2,IBUGG3
 9013 FORMAT('IBUGGR,IBUGG2,IBUGG3 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGPL,IBUGP,IBUGP1,IBUGP2,IBUGP3
 9014 FORMAT('IBUGPL,IBUGP,IBUGP1,IBUGP2,IBUGP3 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGCO,IBUGEV,IBUGQ,ISUBRO
 9015 FORMAT('IBUGCO,IBUGEV,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU,MAXNPP,ISEED,IBOOSS
 9017 FORMAT('IANGLU,MAXNPP,ISEED,IBOOSS = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ICASPL
 9018 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IAND1,IAND2
 9019 FORMAT('IAND1,IAND2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IFENSW
 9021 FORMAT('IFENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9035)MAXNPP
 9035 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)IX1TSC,IX2TSC,IY1TSC,IY2TSC
 9041 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IX1TSV,IX2TSV,IY1TSV,IY2TSV
 9042 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ANOPL1,ANOPL2
 9051 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MAININ(IBUGIN,ICOMHO,ICOMH2)
C
C     PURPOSE--THIS IS SUBROUTINE MAININ.
C              (THE   IN    AT THE END OF    MAINPC   STANDS FOR   INITIAL
C              THIS SUBROUTINE INITIALIZES ALL NEEDED CONSTANTS
C              FOR THE   AREAS--MC = MACHINE CONSTANTS
C                             --DB = DEBUGGING
C                             --HK = HOUSEKEEPING
C                             --PC = PLOT CONTROL
C                             --OD = OUTPUT DEVICES
C                             --SU = SUPPORT
C                             --GR = GRAPHICS
C                             --AN = ANALYSIS
C                             --DA = DATA
C                             --DG = DIAGRAMMATIC GRAPHICS
C                             --H2 = HOUSEKEEPING (PART 2)
C                             --3D = 3-DIMENSIONAL
C     THIS ROUTINE IS TYPICALLY CALLED ONLY ONCE PER DATAPLOT RUN
C     (IMMEDIATELY AFTER SIGN-ON).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/1
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --MAY       1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1986.
C     UPDATED         --SEPTEMBER 1988.  GENERAL 3-D
C     UPDATED         --DECEMBER  1988.  RESET2
C     UPDATED         --MAY       1989.  INITIALIZE DES. OF EXP. COMMON
C     UPDATED         --AUGUST    1990.  INITIALIZE WINDOW SYSTEM
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGIN
      CHARACTER*4 ICOMHO
      CHARACTER*4 ICOMH2
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCO3D.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
CCCCC IF(IBUGIN.EQ.'OFF')GOTO90
CCCCC WRITE(ICOUT,999)
  999 FORMAT(1X)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,51)
CCC51 FORMAT('AT THE BEGINNING OF MAININ--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,53)IBUGPC
CCC53 FORMAT('IBUGPC = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCC90 CONTINUE
C
C               ****************************************************************
C               **  STEP 1--
C               **  INITIALIZE VARIABLES AND PARAMETERS.
C               **  11 INITIALIZATION SUBROUTINES ARE CALLED--
C               **        INITMC--INITIALIZE MACHINE CONSTANTS
C               **        INITFO--INITIALIZE FILE OPERATIONS
C               **        INITHK--INITIALIZE HOUSEKEEPING           VARIABLES AN
C               **        INITDA--INITIALIZE DATA                   VARIABLES.
C               **        INITPC--INITIALIZE PLOT CONTROL  COMMANDS VARIABLES AN
C               **        INITDG--INITIALIZE DIAGRAMMATIC GRAPHICS  COMMANDS VAR
C               **        INITOD--INITIALIZE OUTPUT DEVICE COMMANDS VARIABLES AN
C               **        INITSU--INITIALIZE SUPPORT       COMMANDS VARIABLES AN
C               **        INITH2--INITIALIZE HOUSEKEEPING (PART 2)  VARIABLES AN
C               **        INITDB--INITIALIZE DEBUGGING              VARIABLES.
C               **        INIT3D--INITIALIZE 3-DIMENSIONAL          VARIABLES.
C               ****************************************************************
C
      IF(ICOMHO.EQ.'RESE'.AND.ICOMH2.EQ.'T2  ')GOTO1010
      CALL INITMC(IBUGIN)
 1010 CONTINUE
C
      IF(ICOMHO.EQ.'RESE'.AND.ICOMH2.EQ.'T2  ')GOTO1020
      CALL INITFO(IBUGIN)
 1020 CONTINUE
C
      CALL INITHK(IBUGIN)
      CALL INITDA(IBUGIN)
      CALL INITPC(IBUGIN)
CCCCC CALL INITDG(IBUGIN)
C     DIAGRAMMATIC GRAPHICS INITIALIZATION  IS NOW DONE (NOV 1983) IN INITPC
C
      IF(ICOMHO.EQ.'RESE'.AND.ICOMH2.EQ.'T2  ')GOTO1070
      CALL INITOD(IBUGIN)
 1070 CONTINUE
C
      CALL INITSU(IBUGIN)
CCCCC THE FOLLOWING DES. OF EXP. LINE WAS ADDED MAY 1989
      CALL INITDE(IBUGIN)
      CALL INIT3D(IBUGIN)
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      CALL INITWI(IBUGIN)
C
      CALL INITH2(IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,
     1IVALUE,VALUE,NUMNAM,MAXN,MAXCOL,IBUGIN)
      CALL INITDB
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGIN.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF MAININ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGIN
 9013 FORMAT('IBUGIN = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MAINOD(IBUGOD,IBUGO2,ISUBRO,
     1ICAPSW,
     1IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAINOD.
C              (THE   OD    AT THE END OF    MAINOD   STANDS FOR   OUTPUT DEVICE
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES OUTPUT DEVICE COMMANDS.
C              THE OUTPUT DEVICE COMMANDS SEARCHED FOR BY MAINOD ARE AS FOLLOWS-
C
C                   1) DEVICE ... POWER                  ON/OFF
C                   2) DEVICE ... MANUFACTURER           A MANUFACTURER AND MODE
C                   3) DEVICE ... CONTINUOUS             ON/OFF
C                   4) DEVICE ... COLOR                  ON/OFF
C                   5) DEVICE ... PICTURE POINTS         2 NUMBERS
C                   6) DEVICE ... UNIT NUMBER            A NUMBER
C
C                   7) TERMINAL   POWER                  ON/OFF
C                   8) TERMINAL   MANUFACTURER           A MANUFACTURER AND MODE
C                   8) TERMINAL   CONTINUOUS             ON/OFF
C                   9) TERMINAL   COLOR                  ON/OFF
C                  10) TERMINAL   PICTURE POINTS         2 NUMBERS
C                   6) TERMINAL UNIT NUMBER            A NUMBER
C
C                  11) POWER                             ON/OFF
C                  12) MANUFACTURER                      A MANUFACTURER AND MODE
C                  13) CONTINUOUS                        ON/OFF
C                  14) COLOR                             ON/OFF
C                  15) PICTURE POINTS                    2 NUMBERS
C                   16) UNIT NUMBER            A NUMBER
C
C                  16) DISCRETE                          ON/OFF
C                  17) DISCRETE NARROW-WIDTH             ON/OFF
C                  18) DISCRETE WIDE-CARRIAGE            ON/OFF
C                  19) BATCH                             ON/OFF
C
C                  20) FILE                              ON/OFF
C                  20) CALCOMP                           ON/OFF
C                  21) VERSATEC                          ON/OFF
C                  22) ZETA                              ON/OFF
C
C                  22) METAFILE                              ON/OFF
C
C                  23) HARDCOPY                          ON/OFF AND OPTIONALLY A
C                  24) PENPLOTTER                        ON/OFF AND OPTIONALLY A
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  1989.  2 OFFSET ARGUMENTS IN CALLS TO DPDEMN
C     UPDATED         --FEBRUARY  1989.  ADD CHECKS FOR NEW DEVICES (ALAN)--
C                                           GENERAL CGM (OR CGM)
C                                           QUIC (OR QMS)
C                                           POSTSCRIPT
C                                           PCL (OR LASERJET)
C                                           DICOMED
C     UPDATED         --MARCH     1990.   ADD CHECK FOR X11 DEVICE
C     UPDATED         --MAY       1990.   CHECK FOR [HPGL/ZETA/CALC] PEN MAP,
C                                         DISTINGUISH BETWEEN ON/OFF AND
C                                         OPEN/CLOSE
C     UPDATED         --JANUARY   1991.   ADD REGIS TO PEN MAP COMMAND
C     UPDATED         --MAY       1991.   ADD TURBO-C/VGA (JJF)
C     UPDATED         --JUNE      1991.   ADD X11 TO PEN MAP COMMAND
C     UPDATED         --OCTOBER   1991.   ADD "POSTSCRIPT SHOW FONT" COMMAND
C     UPDATED         --APRIL     1992.   PRINT PLOT, P, PP
C     UPDATED         --MAY       1992.   POSTSCRIPT BLANK PAGE SWITCH
C     UPDATED         --JUNE      1992.   ARGUMENT LIST TO DPDEMN
C     UPDATED         --AUGUST    1992.   ADD "SHOW COLORS" COMMAND.
C     UPDATED         --APRIL     1993.   CHECK FOR CONFLICT WITH
C                                         P CONTROL CHART (ALAN)
C     UPDATED         --OCTOBER   1993.   BUG FOR DISCRETE ON
C     UPDATED         --DECEMBER   1993.  COMMENT OUT   GENERAL
C     UPDATED         --MAY        1994.  CHECK CONFLICT BETWEEN REGIS
C                                         AND REGION
C     UPDATED         --SEPTEMBER  1994.  CHECK CONFLICT BETWEEN DISCR
C                                         AND DISCR UNIFORM PROB PLOT
C     UPDATED         --APRIL      1995.  CHECK CONFLICT BETWEEN POWER
C                                         AND POWER NORMAL AND POWER
C                                         LOGNORMAL (PROB PLOT, PPCC 
C                                         PLOT)
C     UPDATED         --OCTOBER    1995.  CHECK CONFLICT BETWEEN GENERAL
C                                         AND GENERALIZED EXTREME VALUE
C                                         AND GENERALIZED HALF LOGISTIC
C                                         (PROB AND PPCC PLOTS)
C     UPDATED         --DECEMBER   1995.  CHECK CONFLICT BETWEEN GENERAL
C                                         AND GENERALIZED LOGISTIC
C     UPDATED         --FEBRUARY   1996.  CHECK CONFLICT BETWEEN GENERAL
C                                         AND GENERALIZED EXPONENTIAL
C     UPDATED         --JULY       1996.  DEVICE ... FONT COMMAND
C     UPDATED         --OCTOBER    1996.  ADD CHECKS FOR NEW DEVICES (ALAN)--
C                                           MICROSOFT QUICKWIN  
C                                           PBM (PORTABLE BIT MAP)
C     UPDATED         --JUNE       1998.  NAME CONFLICT WITH POWER MLE
C     UPDATED         --JUNE       2000.  ADD CHECKS FOR NEW DEVICES (ALAN)--
C                                           OPEN-GL
C                                           GD JPEG
C                                           GD PNG
C                                           GD WBMP
C                                           WINDOWS BITMAP
C     UPDATED         --MARCH      2002.  ADD CHECKS FOR NEW DEVICES (ALAN)--
C                                           SVG
C     UPDATED         --SEPTEMBER  2002.  ICAPSW FOR DPDEMN, DPDEPW
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IOP
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IBUGOD
      CHARACTER*4 IBUGO2
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOF2.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   MAY 1992 (JJF)
      INCLUDE 'DPCODV.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
      I=1
      IOP='-999'
C
      IF(IBUGOD.EQ.'OFF'.AND.ISUBRO.NE.'INOD')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAINOD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGOD,IBUGO2,ISUBRO
   53 FORMAT('IBUGOD,IBUGO2,ISUBRO = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS ADDED   MAY 1992 (JJF)
      WRITE(ICOUT,54)IPSTBP
   54 FORMAT('IPSTBP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFOUND,IERROR
   60 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
C               ******************************
C               **  TREAT THE GENERAL (= DEVICE-INDEPENDENT) CASE  **
C               ******************************
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT         DECEMBER 1993
CCCCC TO AVOID CONFLICT WITH                       DECEMBER 1993
CCCCC GENERAL PARETO PPCC PLOT Y                   DECEMBER 1993
CCCCC IF(ICOM.EQ.'GENE')GOTO1000
CCCCC PUT IN TEST                                  FEBRUARY 1994
CCCCC PUT IN TEST FOR EXTREME VALUE, HALF LOGI     OCTOBER  1995
      IF(ICOM.EQ.'GENE')THEN
        IF(NUMARG.LT.1)GOTO1000
        IF(NUMARG.GE.2)THEN
          IF(IHARG(2).EQ.'PROB')GOTO109
          IF(IHARG(2).EQ.'PPCC')GOTO109
        ENDIF
        IF(NUMARG.GE.1)THEN
          IF(IHARG(1).EQ.'PARE')GOTO109
          IF(IHARG(1).EQ.'LOGI')GOTO109
          IF(IHARG(1).EQ.'PPCC')GOTO109
          IF(IHARG(1).EQ.'PROB')GOTO109
          IF(IHARG(1).EQ.'GAMM')GOTO109
          IF(IHARG(1).EQ.'EXTR')GOTO109
          IF(IHARG(1).EQ.'HALF')GOTO109
          IF(IHARG(1).EQ.'LOGI')GOTO109
          IF(IHARG(1).EQ.'EXPO')GOTO109
          IF(IHARG(1).EQ.'LAMB')GOTO109
          IF(IHARG(1).EQ.'TRAP')GOTO109
          IF(IHARG(1).EQ.'MCLE')GOTO109
          IF(IHARG(1).EQ.'INVE'.AND.IHARG(2).EQ.'GAUS')GOTO109
          IF(IHARG(1).EQ.'ASYM'.AND.IHARG(2).EQ.'LAPL')GOTO109
          IF(IHARG(1).EQ.'ASYM'.AND.IHARG(2).EQ.'DOUB')GOTO109
          IF(IHARG(1).EQ.'TUKE'.AND.IHARG(2).EQ.'LAMB')GOTO109
          GOTO1000
        ENDIF
      ENDIF
 109  CONTINUE
CCCCC THE FOLLOWING LINE WAS INSERTED BY ALAN.  FEBRUARY 1989
      IF(ICOM.EQ.'CGM')GOTO1000
      IF(ICOM.EQ.'DEVI'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'INDE')GOTO1000
C  MAY, 1990.  CHECK FOR FOLLOWING COMMANDS:
C   HPGL PEN MAP  (OR HPGL PEN OR HPGL MAP)
C   ZETA PEN MAP  (OR ZETA PEN OR ZETA MAP)
C   CALCOMP PEN MAP (OR CALCOMP PEN OR CALCOMP MAP)
      IF(ICOM.EQ.'HPGL'.AND.IHARG(1).EQ.'PEN')GOTO200
      IF(ICOM.EQ.'HPGL'.AND.IHARG(1).EQ.'MAP')GOTO200
      IF(ICOM.EQ.'HP-G'.AND.IHARG(1).EQ.'PEN')GOTO200
      IF(ICOM.EQ.'HP-G'.AND.IHARG(1).EQ.'MAP')GOTO200
      IF(ICOM.EQ.'ZETA'.AND.IHARG(1).EQ.'PEN')GOTO200
      IF(ICOM.EQ.'ZETA'.AND.IHARG(1).EQ.'MAP')GOTO200
      IF(ICOM.EQ.'CALC'.AND.IHARG(1).EQ.'PEN')GOTO200
      IF(ICOM.EQ.'CALC'.AND.IHARG(1).EQ.'MAP')GOTO200
C  FOLLOWING LINES ADDED JANUARY, 1991.  ADD COLOR MAP AND REGIS.
      IF(ICOM.EQ.'HPGL'.AND.IHARG(1).EQ.'COLO')GOTO200
      IF(ICOM.EQ.'HP-G'.AND.IHARG(1).EQ.'COLO')GOTO200
      IF(ICOM.EQ.'ZETA'.AND.IHARG(1).EQ.'COLO')GOTO200
      IF(ICOM.EQ.'CALC'.AND.IHARG(1).EQ.'COLO')GOTO200
      IF(ICOM.EQ.'REGI'.AND.ICOM2.EQ.'S   '.AND.IHARG(1).EQ.'MAP')
     *  GOTO200
      IF(ICOM.EQ.'REGI'.AND.ICOM2.EQ.'S   '.AND.IHARG(1).EQ.'PEN')
     *  GOTO200
      IF(ICOM.EQ.'REGI'.AND.ICOM2.EQ.'S   '.AND.IHARG(1).EQ.'COLO')
     * GOTO200
C  FOLLOWING LINES ADDED JUNE, 1991.  ADD "X11 COLORS SHOW" COMMAN
      IF(ICOM.EQ.'X11 '.AND.IHARG(1).EQ.'MAP')GOTO200
      IF(ICOM.EQ.'X11 '.AND.IHARG(1).EQ.'PEN')GOTO200
      IF(ICOM.EQ.'X11 '.AND.IHARG(1).EQ.'COLO')GOTO200
C  FOLLOWING LINES ADDED OCTOBER, 1991.  ADD "POSTSCRIPT SHOW FONTS" COMMAND
      IF(ICOM.EQ.'POST'.AND.IHARG(1).EQ.'SHOW')GOTO210
      IF(ICOM.EQ.'POST'.AND.IHARG(1).EQ.'LIST')GOTO210
      IF(ICOM.EQ.'POST'.AND.IHARG(1).EQ.'PRIN')GOTO210
      IF(ICOM.EQ.'POST'.AND.IHARG(1).EQ.'FONT')GOTO210
C  AUGUST 1992.  ADD FOLLOWING LINE. (ALAN)
      IF(ICOM.EQ.'SHOW')GOTO220
      GOTO1099
C
C        *********************************************
C        **  <DEVICE> PEN MAP CASE                  **
C        *********************************************
C
 200  CONTINUE
      CALL DPDEPM(ICOM,IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IBUGO2,ISUBRO,IFOUND,IERROR)
      GOTO9000
C
C        *********************************************
C        **  <DEVICE> SHOW FONTS CASE               **
C        *********************************************
C
  210 CONTINUE
      CALL DPDEFN(ICOM,IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IBUGO2,ISUBRO,IFOUND,IERROR)
      GOTO9000
C
CCCCC THE FOLLOWING SECTION WAS ADDED   AUGUST 1992 (ALAN)
C        *********************************************
C        **  SHOW COLORS      CASE                  **
C        *********************************************
C
  220 CONTINUE
      CALL DPDEPM(ICOM,IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IBUGO2,ISUBRO,IFOUND,IERROR)
      GOTO9000
C
 1000 CONTINUE
      IOP='ON'
      IF(NUMARG.GE.1.AND.IHARG(NUMARG).EQ.'OFF')IOP='OFF'
      ICOM='DEVI'
      ICOM2='CE  '
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
C
      IF(IOP.EQ.'ON')GOTO1010
      GOTO1020
C
 1010 CONTINUE
      IHARG(2)='MANU'
      IHARG2(2)='FACT'
      IARGT(2)='WORD'
      IHARG(3)='GENE'
      IHARG2(3)='RAL '
      IARGT(3)='WORD'
      NUMARG=3
      IF(IHARG(4).EQ.'CODE')NUMARG=4
CCCCC THE FOLLOWING LINE WAS INSERTED BY ALAN.  FEBRUARY 1989
      IF(IHARG(4).EQ.'CGM')NUMARG=4
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO1099
C
 1020 CONTINUE
      IHARG(2)='POWE'
      IHARG2(2)='R   '
      IARGT(2)='WORD'
      IHARG(3)='OFF '
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO1099
C
 1099 CONTINUE
C
CCCCC THE FOLLOWING SECTION  WAS ADDED   APRIL 1992  (JJF)
C               ****************************************
C               **  TREAT THE P CASE                  **
C               **  TREAT THE PP CASE                 **
C               **  TREAT THE PRINT PLOT CASE         **
C               ****************************************
C
      IF(IBUGOD.EQ.'ON')CALL TRACE2('7000','MAIN','OD  ')
C
CCCCC APRIL 1993    CHECK FOR CONFLICT WITH P CHART
CCCCC APRIL 1993    AND P CONTROL CHART (ALAN)
      IF(ICOM.EQ.'P'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO9000
      IF(ICOM.EQ.'P'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO9000
C
      IF(ICOM.EQ.'P')GOTO7000
      IF(ICOM.EQ.'PP')GOTO7000
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'PRIN'.AND.
     1   IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO7000
      ENDIF
      GOTO7099
C
CCCCC (SEE ALSO MAIN, PLOTG2, DPERAS)
CCCCC (SEE ALSO GRERSC AND GRINDE)???
 7000 CONTINUE
      IFOUND='YES'
      IF(IPL2CS.NE.'CLOS')THEN
         CALL DPDEV(3,'CLOS','POST',ICAPSW,IBUGOD,ISUBRO,IERROR)
         IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7011)
 7011       FORMAT('***** ERROR IN MAINOD')
      CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,7012)
 7012       FORMAT('      IN ATTEMPTING TO CLOSE DEVICE 3')
      CALL DPWRST('XXX','BUG ')
            GOTO9000
         ENDIF
      ENDIF
      CALL PRINFI(IPL2NA,IBUGO2,ISUBRO,IERROR)
      GOTO9000
C
 7099 CONTINUE
C
C               **************************************
C               **  TREAT THE DEVICE ... POWER CASE **
C               **************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1199 CONTINUE
C
C               ********************************************
C               **  TREAT THE DEVICE ... CONTINUOUS CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      CALL DPDECN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFCN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1299 CONTINUE
C
C               ********************************************
C               **  TREAT THE DEVICE ... COLOR      CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      CALL DPDECL(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFDC,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
C
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1399 CONTINUE
C
C               *************************************************
C               **  TREAT THE DEVICE ... PICTURE POINTS CASE   **
C               *************************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      CALL DPDEPP(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFVP,IDEFHP,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1499 CONTINUE
C
C               *************************************************
C               **  TREAT THE DEVICE ... UNIT        CASE   **
C               *************************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      CALL DPDEUN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1599 CONTINUE
CCCCC FOLLOWING SECTION ADDED JULY 1996.
C
C               ********************************************
C               **  TREAT THE DEVICE ... FONT       CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1800
      GOTO1899
C
 1800 CONTINUE
      CALL DPDEFT(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFFN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
C
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1899 CONTINUE
C
C               ***********************************************
C               **  TREAT THE DEVICE ...  (MANUFACTURER) CASE  **
C               ***********************************************
C
      IF(ICOM.EQ.'DEVI')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1699 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS INSERTED BY ALAN.  FEBRUARY 1989
CCCCC MAY, 1990. DISTINGUISH BETWEEN ON/OFF AND OPEN/CLOSE
C               *****************************************************
C               **  TREAT THE DEVICE ... ON/OFF (OR OPEN/CLOSE) CASE*
C               *****************************************************
C
      IF(NUMARG.LT.1)GOTO1799
      IF(ICOM.EQ.'DEVI'.AND.NUMARG.GE.1.AND.
     1IHARG(NUMARG).EQ.'OFF')GOTO1705
      IF(ICOM.EQ.'DEVI'.AND.NUMARG.GE.1.AND.
     1IHARG(NUMARG).EQ.'CLOS')GOTO1704
      IF(ICOM.EQ.'DEVI'.AND.NUMARG.GE.1.AND.
     1IHARG(NUMARG).EQ.'ON')GOTO1700
      IF(ICOM.EQ.'DEVI'.AND.NUMARG.GE.1.AND.
     1IHARG(NUMARG).EQ.'OPEN')GOTO1701
      GOTO1799
C
 1700 CONTINUE
      IOP='ON'
      GOTO1709
 1701 CONTINUE
      IOP='OPEN'
      GOTO1709
 1704 CONTINUE
      IOP='CLOS'
      GOTO1709
 1705 CONTINUE
      IOP='OFF'
 1709 CONTINUE
C
      IF(NUMARG.GT.1)GOTO1720
C
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      GOTO1729
C
 1720 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)=IHARG(2)
      IHARG2(1)=IHARG2(2)
      IARGT(1)=IARGT(2)
      IARG(1)=IARG(2)
C
 1729 CONTINUE
      IHARG(2)='POWE'
      IHARG2(2)='ER  '
      IARGT(2)='WORD'
      IHARG(3)=IOP
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO1799
C
 1799 CONTINUE
C
C               ***********************************
C               **  PRE-TREAT THE TERMINAL CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'TERM'.AND.IHARG(1).EQ.'CHAR')GOTO9000
      IF(ICOM.EQ.'TERM')GOTO2000
      GOTO2099
C
 2000 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
C
 2099 CONTINUE
C
C               *******V************************************
C               **  TREAT THE TERMINAL POWER        CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'TERM')GOTO2100
      GOTO2199
C
C
 2100 CONTINUE
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2199 CONTINUE
C
C               ******************************************
C               **  TREAT THE TERMINAL CONTINUITY CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'TERM')GOTO2200
      GOTO2299
C
 2200 CONTINUE
      CALL DPDECN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFCN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2299 CONTINUE
C
C               *************************************
C               **  TREAT THE TERMINAL COLOR CASE  **
C               **********T**************************
C
      IF(ICOM.EQ.'TERM')GOTO2300
      GOTO2399
C
 2300 CONTINUE
      CALL DPDECL(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFDC,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2399 CONTINUE
C
C               **********************************************
C               **  TREAT THE TERMINAL PICTURE POINTS CASE  **
C               **********************************************
C
      IF(ICOM.EQ.'TERM')GOTO2400
      GOTO2499
C
 2400 CONTINUE
      CALL DPDEPP(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFVP,IDEFHP,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2499 CONTINUE
C
C               *************************************
C               **  TREAT THE TERMINAL UNIT NUMBER CASE  **
C               *************************************
C
      IF(ICOM.EQ.'TERM')GOTO2500
      GOTO2599
C
 2500 CONTINUE
      CALL DPDEUN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
C
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2599 CONTINUE
C
C               ********************************************
C               **  TREAT THE TERMINAL MANUFACTURER CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'TERM')GOTO2600
      GOTO2699
C
 2600 CONTINUE
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2699 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS INSERTED BY ALAN.  FEBRUARY 1989
CCCCC BUG FIX MAY, 1990 (SENT TO WRONG PLACE)
C               *****************************************************
C               **  TREAT THE TERMINAL .. ON/OFF (OR OPEN/CLOSE) CASE
C               *****************************************************
C
      IF(NUMARG.LT.1)GOTO2799
      IF(ICOM.EQ.'TERM'.AND.NUMARG.EQ.1.AND.
     1IHARG(1).EQ.'OFF')GOTO2705
      IF(ICOM.EQ.'TERM'.AND.NUMARG.EQ.1.AND.
     1IHARG(1).EQ.'CLOS')GOTO2705
      IF(ICOM.EQ.'TERM'.AND.NUMARG.EQ.1.AND.
     1IHARG(1).EQ.'ON')GOTO2700
      IF(ICOM.EQ.'TERM'.AND.NUMARG.EQ.1.AND.
     1IHARG(1).EQ.'OPEN')GOTO2700
      GOTO2799
C
 2700 CONTINUE
      IOP='ON'
      GOTO2709
 2705 CONTINUE
      IOP='OFF'
 2709 CONTINUE
      ICOM='DEVI'
      ICOM2='CE  '
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)='POWE'
      IHARG2(2)='ER  '
      IARGT(2)='WORD'
      IHARG(3)=IOP
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO2799
C
 2799 CONTINUE
C
C               ****************************
C               **  TREAT THE POWER CASE  **
C               ****************************
C
CCCCC MAY 1995.  CHECK NAME CONFLICTS
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'NORM')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'LOGN')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'EXPO')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'LOG ')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'FUNC')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'PROB')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'PPCC')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'MAXI')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'MLE ')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'KS  ')GOTO3199
      IF(ICOM.EQ.'POWE'.AND.IHARG(1).EQ.'KOLM')GOTO3199
C
      IF(ICOM.EQ.'POWE')GOTO3100
      GOTO3199
C
 3100 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)=ICOM
      IHARG2(2)=ICOM2
      IARGT(2)='WORD'
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3199 CONTINUE
C
C               *********************************
C               **  TREAT THE CONTINUITY CASE  **
C               *********************************
C
      IF(ICOM.EQ.'CONT'.AND.ICOM2.EQ.'INUO')GOTO3200
      IF(ICOM.EQ.'CONT'.AND.ICOM2.EQ.'INUI')GOTO3200
      GOTO3299
C
 3200 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)=ICOM
      IHARG2(2)=ICOM2
      IARGT(2)='WORD'
      CALL DPDECN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFCN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3299 CONTINUE
C
C               ****************************
C               **  TREAT THE COLOR CASE  **
C               ****************************
C
      IF(ICOM.EQ.'COLO')GOTO3300
      GOTO3399
C
 3300 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)=ICOM
      IHARG2(2)=ICOM2
      IARGT(2)='WORD'
      CALL DPDECL(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFDC,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3399 CONTINUE
C
C               *************************************
C               **  TREAT THE PICTURE POINTS CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PICT')GOTO3400
      IF(ICOM.EQ.'PP')GOTO3400
      GOTO3499
C
 3400 CONTINUE
      ISHIFT=2
      IF(ICOM.EQ.'PP')ISHIFT=3
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)='PICT'
      IHARG2(2)='TURE'
      IARGT(2)='WORD'
      IF(ICOM.EQ.'PICT')GOTO3410
      IHARG(3)='POIN'
      IHARG2(3)='TS  '
      IARGT(3)='WORD'
 3410 CONTINUE
      CALL DPDEPP(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFVP,IDEFHP,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3499 CONTINUE
C
C               *************************************
C               **  TREAT THE UNIT NUMBER CASE  **
C               *************************************
C
      IF(ICOM.EQ.'UNIT')GOTO3500
      GOTO3599
C
 3500 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)=ICOM
      IHARG2(2)=ICOM2
      IARGT(2)='WORD'
      CALL DPDEUN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IBUGO2,IFOUND,IERROR)
C
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3599 CONTINUE
C
C               *********************************************
C               **  TREAT THE EXPLICIT MANUFACTURER CASE   **
C               **  (FOR A SUBSET OF AVAILABLE TERMINALS)  **
C               *********************************************
C
      IF(ICOM.EQ.'TEKT'.AND.IHARG(1).NE.'META')GOTO3600
      IF(ICOM.EQ.'HEWL')GOTO3600
      IF(ICOM.EQ.'HP')GOTO3600
      IF(ICOM.EQ.'HPGL')GOTO3600
      IF(ICOM.EQ.'RAMT')GOTO3600
      IF(ICOM.EQ.'TELE')GOTO3600
      IF(ICOM.EQ.'VT')GOTO3600
      IF(ICOM.EQ.'DEC')GOTO3600
CCCCC MAY, 1994.  CHECK FOR CONFLICT WITH REGION COMMAND.
CCCCC IF(ICOM.EQ.'REGI')GOTO3600
      IF(ICOM.EQ.'REGI'.AND.ICOM2.EQ.'S   ')GOTO3600
      IF(ICOM.EQ.'RAMT')GOTO3600
CCCCC THE FOLLOWING 5 LINES WERE ADDED BY ALAN.  FEBRUARY 1989
      IF(ICOM.EQ.'SUN')GOTO3600
      IF(ICOM.EQ.'PCL')GOTO3600
      IF(ICOM.EQ.'POST')GOTO3600
CCCCC MARCH 1995.  ADD FOLLOWING 3 LINES
      IF(ICOM.EQ.'ENCA')THEN
        IF(IHARG(1).EQ.'POST'.OR.IHARG(1).EQ.'PS')THEN
          ICOM='POST'
          IHARG(1)='ENCA'
        ELSE
          ISHIFT=1
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1    IBUGO2,IERROR)
          ICOM='POST'
          IHARG(1)='ENCA'
          IHARG2(1)='    '
          IARGT(1)='WORD'
        ENDIF
        GOTO3600
      ENDIF
CCCCC OCTOBER 1996.  ADD FOLLOWING LINES
      IF(ICOM.EQ.'DISP')THEN
        IF(IHARG(1).EQ.'POST'.OR.IHARG(1).EQ.'PS')THEN
          ICOM='POST'
          IHARG(1)='DISP'
          GOTO3600
        ENDIF
      ENDIF
C
      IF(ICOM.EQ.'PS  ')THEN
        ICOM='POST'
        GOTO3600
      ENDIF
      IF(ICOM.EQ.'EPS ')THEN
        IF(IHARG(1).EQ.'POST')THEN
          ICOM='POST'
          IHARG(1)='ENCA'
        ELSE
          ISHIFT=1
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1    IBUGO2,IERROR)
          ICOM='POST'
          IHARG(1)='ENCA'
          IHARG2(1)='    '
          IARGT(1)='WORD'
        ENDIF
        GOTO3600
      ENDIF
C
      IF(ICOM.EQ.'DICO')GOTO3600
      IF((ICOM.EQ.'QUIC'.AND.ICOM2.EQ.'KWIN').OR.
     1 (ICOM.EQ.'QUIC'.AND.ICOM2.EQ.'K-WI').OR.
     1 (ICOM.EQ.'MS'.AND.IHARG(1).EQ.'WIND').OR.
     1 (ICOM.EQ.'MICR'.AND.IHARG(1).EQ.'WIND'))THEN
        ICOM='QWIN'
        IHARG(1)='    '
        IARGT(1)='WORD'
        GOTO3600
      ENDIF
      IF(ICOM.EQ.'QUIC')GOTO3600
CCCCC FOLLOWING LINE ADDED MARCH 1990 BY ALAN.
      IF(ICOM.EQ.'X11 ')GOTO3600
CCCCC FOLLOWING 2 LINES ADDED FOR CONFLICT WITH DISCRET UNIFORM 
CCCCC PROBABILITY PLOT.   SEPTEMBER 1994.
      IF(NUMARG.GE.2.AND.ICOM.EQ.'DISC'.AND.IHARG(1).EQ.'UNIF')GOTO9000
      IF(NUMARG.GE.2.AND.ICOM.EQ.'DISC'.AND.IHARG(1).EQ.'PROB')GOTO9000
      IF(ICOM.EQ.'DISC')GOTO3600
      IF(ICOM.EQ.'BATC')GOTO3600
CCCCC SEPTEMBER 1997.  CHECK FOR CONFLICT WITH ANDERSON DARLING TEST
CCCCC IF(ICOM.EQ.'ANDE')GOTO3600
      IF(ICOM.EQ.'ANDE')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DARL')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'TEST')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NORM')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WEIB')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'EXPO')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LOGI')GOTO9000
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'EXPO')GOTO9000
        GOTO3600
      ENDIF
      IF(ICOM.EQ.'AJ')GOTO3600
      IF(ICOM.EQ.'HAZE')GOTO3600
      IF(ICOM.EQ.'OMRO')GOTO3600
      IF(ICOM.EQ.'TERM'.AND.ICOM2.EQ.'INET')GOTO3600
      IF(ICOM.EQ.'TEXA')GOTO3600
      IF(ICOM.EQ.'TI')GOTO3600
CCCCC THE FOLLOWING 4 LINES WERE ADDED MAY 1991 (JJF)
 
      IF(ICOM.EQ.'TURB')GOTO3600
      IF(ICOM.EQ.'TC')GOTO3600
      IF(ICOM.EQ.'VGA')GOTO3600
      IF(ICOM.EQ.'EGA')GOTO3600
      IF(ICOM.EQ.'LAHE ')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'INTE')THEN
          ICOM='INTE'
          IHARG(1)='    '
          NUMARG=0
        ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'WINT')THEN
          ICOM='WINT'
          IHARG(1)='    '
          NUMARG=0
        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'WIN '.AND.
     1         IHARG(2).EQ.'INTE')THEN
          ICOM='WINT'
          IHARG(1)='    '
          IHARG(2)='    '
          NUMARG=0
        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'WIND'.AND.
     1         IHARG(2).EQ.'INTE')THEN
          ICOM='WINT'
          IHARG(1)='    '
          IHARG(2)='    '
          NUMARG=0
        ELSE
          ISHIFT=1
          CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1    IBUGO2,IERROR)
          ICOM='POST'
          IHARG(1)='ENCA'
          IHARG2(1)='    '
          IARGT(1)='WORD'
        ENDIF
        GOTO3600
      ENDIF
C
      IF(ICOM.EQ.'GKS ')GOTO3600
      IF(ICOM.EQ.'GD  ')GOTO3600
      IF(ICOM.EQ.'SVG ')GOTO3600
      IF(ICOM.EQ.'OPEN'.AND.ICOM2.EQ.'GL  ')THEN
          ICOM='OPGL'
          GOTO3600
      ENDIF
      IF(ICOM.EQ.'OPEN'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GL  ')THEN
          ICOM='OPGL'
          ISHIFT=1
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGO2,IERROR)
          GOTO3600
      ENDIF
C
      GOTO3699
C
 3600 CONTINUE
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)=ICOM
      IHARG2(2)=ICOM2
      IARGT(2)='WORD'
CCCCC OCTOBER 1993.  FIX BUG WHERE DISCRETE ON, BATCH ON ACT
CCCCC LIKE DISCRETE OFF, ETC.  STRIP OFF ON ARGUMENT.
      IF(IHARG(2).EQ.'DISC'.OR.IHARG(2).EQ.'BATC')THEN
        IF(NUMARG.GE.3.AND.IHARG(NUMARG).EQ.'ON')THEN
          IHARG(NUMARG)='    '
          NUMARG=NUMARG-1
        ENDIF
      ENDIF
CCCCC END CHANGE
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3699 CONTINUE
C
C               *********************************************
C               **  TREAT THE DISCRETE CASE                **
C               **  TREAT THE DISCRETE NARROW-WIDTH CASE   **
C               **  TREAT THE DISCRETE WIDE-CARRIAGE CASE  **
C               **  TREAT THE BATCH    CASE                **
C               *********************************************
C
      IF(ICOM.EQ.'DISC')GOTO4100
      IF(ICOM.EQ.'BATC')GOTO4100
      GOTO4199
C
 4100 CONTINUE
      ISHIFT=3
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
      IHARG(2)='MANU'
      IHARG2(2)='FACT'
      IARGT(2)='WORD'
      IHARG(3)=ICOM
      IHARG2(3)=ICOM2
      IARGT(3)='WORD'
CCCCC OCTOBER 1993.  FIX BUG WHERE DISCRETE ON, BATCH ON ACT
CCCCC LIKE DISCRETE OFF, ETC.  STRIP OFF ON ARGUMENT.
      IF(IHARG(2).EQ.'DISC'.OR.IHARG(2).EQ.'BATC')THEN
        IF(NUMARG.GE.3.AND.IHARG(NUMARG).EQ.'ON')THEN
          IHARG(NUMARG)='    '
          NUMARG=NUMARG-1
        ENDIF
      ENDIF
CCCCC END CHANGE
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4199 CONTINUE
C
C
C               *********************************
C               **  TREAT THE PENPLOTTER CASE  **
C               *********************************
C
      IF(ICOM.EQ.'PENP')GOTO4200
      GOTO4299
C
 4200 CONTINUE
      IF(NUMARG.LE.0)IOP='ON'
      IF(NUMARG.GE.1)IOP=IHARG(1)
      IF(IOP.EQ.'OPEN')IOP='ON'
      IF(IOP.EQ.'AUTO')IOP='ON'
      IF(IOP.EQ.'DEFA')IOP='ON'
      IF(IOP.EQ.'CLOS')IOP='OFF'
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='1   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=1
C
      IF(IOP.EQ.'ON')GOTO4210
      GOTO4220
C
 4210 CONTINUE
      IHARG(2)='MANU'
      IHARG2(2)='FACT'
      IARGT(2)='WORD'
      IHARG(3)='TEKT'
      IHARG2(3)='RONI'
      IARGT(3)='WORD'
      IHARG(4)='4662'
      IHARG2(I)='    '
      IARGT(4)='WORD'
      NUMARG=4
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO4299
C
 4220 CONTINUE
      IHARG(2)='POWE'
      IHARG2(2)='R   '
      IARGT(2)='WORD'
      IHARG(3)='OFF '
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO4299
C
 4299 CONTINUE
C
C               *******************************
C               **  TREAT THE HARDCOPY CASE  **
C               *******************************
C
      IF(ICOM.EQ.'HARD')GOTO4300
      GOTO4399
C
 4300 CONTINUE
      CALL DPHAPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1ICOPSW,NUMCOP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4399 CONTINUE
C
C               ******************************
C               **  TREAT THE FILE   CASE  **
C               **  TREAT THE CALCOMP CASE  **
C               **  TREAT THE VERSATEC CASE  **
C               **  TREAT THE ZETA     CASE  **
C               ******************************
C
      IF(ICOM.EQ.'TEKT'.AND.IHARG(1).EQ.'META')GOTO5100
      IF(ICOM.EQ.'CALC')GOTO5100
      IF(ICOM.EQ.'VERS')GOTO5100
      IF(ICOM.EQ.'ZETA')GOTO5100
      GOTO5199
C
 5100 CONTINUE
      IDMANU(1)=ICOM
      IDMODE(1)='    '
      IDMOD2(1)='    '
      IDMOD3(1)='    '
      IF(NUMARG.LE.0)IOP='ON'
      IF(NUMARG.GE.1)IOP=IHARG(1)
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'META')IOP='ON'
      IF(IOP.EQ.'OPEN')IOP='ON'
      IF(IOP.EQ.'AUTO')IOP='ON'
      IF(IOP.EQ.'DEFA')IOP='ON'
      IF(IOP.EQ.'CLOS')IOP='OFF'
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='2   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=2
C
      IF(IOP.EQ.'ON')GOTO5110
      GOTO5120
C
 5110 CONTINUE
      IHARG(2)='MANU'
      IHARG2(2)='FACT'
      IARGT(2)='WORD'
      IHARG(3)=IDMANU(1)
      IHARG2(3)='    '
      IARGT(3)='WORD'
      IHARG(4)=IDMODE(1)
      IHARG2(4)='    '
      IARGT(4)='WORD'
      IHARG(5)=IDMOD2(1)
      IHARG2(5)='    '
      IARGT(5)='WORD'
      IHARG(6)=IDMOD3(1)
      IHARG2(6)='    '
      IARGT(6)='WORD'
      NUMARG=6
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO5199
C
 5120 CONTINUE
      IHARG(2)='POWE'
      IHARG2(2)='R   '
      IARGT(2)='WORD'
      IHARG(3)='OFF '
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO5199
C
 5199 CONTINUE
C
C               ******************************
C               **  TREAT THE GENERAL METAFILE   CASE  **
C               ******************************
C
      IF(ICOM.EQ.'META')GOTO5200
      IF(ICOM.EQ.'GENE'.AND.IHARG(1).EQ.'META')GOTO5200
      GOTO5299
C
 5200 CONTINUE
      IF(NUMARG.LE.0)IOP='ON'
      IF(NUMARG.GE.1)IOP=IHARG(1)
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'META')IOP='ON'
      IF(IOP.EQ.'OPEN')IOP='ON'
      IF(IOP.EQ.'AUTO')IOP='ON'
      IF(IOP.EQ.'DEFA')IOP='ON'
      IF(IOP.EQ.'CLOS')IOP='OFF'
C
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGO2,IERROR)
      IHARG(1)='3   '
      IHARG2(1)='    '
      IARGT(1)='NUMB'
      IARG(1)=3
C
      IF(IOP.EQ.'ON')GOTO5210
      GOTO5220
C
 5210 CONTINUE
      IHARG(2)='MANU'
      IHARG2(2)='FACT'
      IARGT(2)='WORD'
      IHARG(3)='META'
      IHARG2(3)='FILE'
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEMN(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IPL1CS,IPL2CS,
     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
     1IDEFPO,IDEFCN,IDEFDC,IDEFVP,IDEFHP,IDEFUN,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO5299
C
 5220 CONTINUE
      IHARG(2)='POWE'
      IHARG2(2)='R   '
      IARGT(2)='WORD'
      IHARG(3)='OFF '
      IHARG2(3)='    '
      IARGT(3)='WORD'
      NUMARG=3
      CALL DPDEPW(IHARG,IHARG2,IARGT,IARG,NUMARG,
     1IPL1NU,IPL1NA,
     1IPL2NU,IPL2NA,
     1IDEFPO,
     1NUMDEV,MAXDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1ICAPSW,ICAPNU,
     1IANS,IWIDTH,IBUGO2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO5299
C
 5299 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1992 (JJF)
C               *********************************
C               **  TREAT THE BLANK PAGE CASE  **
C               *********************************
C
      IF(ICOM.EQ.'BLAN')GOTO5300
      GOTO5399
C
 5300 CONTINUE
      CALL DPBLPA(IHARG,IHARG2,NUMARG,
     1IPSTBP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5399 CONTINUE
C
C               *****************************************
C               **  OUTPUT DEVICE COMMAND NOT FOUND--  **
C               **  BRANCH TO EXIT.                    **
C               *****************************************
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGOD.EQ.'OFF'.AND.ISUBRO.NE.'INOD')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAINOD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGOD,IBUGO2,ISUBRO
 9013 FORMAT('IBUGOD,IBUGO2,ISUBRO = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MAINPC(IBUGPC,IBUGP2,IBUGQ,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
CCCCC ADD FOLLOWING LINE AUGUST 1999.
     1IMPARG,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED    APRIL 1992
     1BARHEF,BARWEF,
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
     1ITIAUT,IX1AUT,IX2AUT,IX3AUT,IY1AUT,IY2AUT,
     1IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAINPC.
C              (THE   PC    AT THE END OF    MAINPC   STANDS FOR   PLOT
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES PLOT CONTROL CO
C              THE PLOT CONTROL COMMANDS SEARCHED FOR BY MAINPC ARE AS F
C
C                      ARROW ... COLOR                   A COLOR
C                      ARROW ... COORDINATES             2 NUMBERS
C                      BACKGROUND COLOR                  A COLOR
C                      BELL                              ON/OFF
C                      BOX ... COLOR                     A COLOR
C                      BOX ... CORNER COORDINATES        4 NUMBERS
C                      CHARACTERS                        A LIST OF CHARA
C                      CHARACTER COLORS                  A LIST OF COLOR
C                      CHARACTER SIZES                   A LIST OF NUMBE
C                      CHARACTER FILL                    A LIST OF ON/OF
C                      EYE COORDINATES                   3 NUMBERS
C                      ...FRAME                          ON/OFF
C                      ...FRAME COLOR                    A COLOR
C                      FRAME CORNER COORDINATES          4 NUMBERS
C                      WINDOW CORNER COORDINATES         4 NUMBERS
C                      ...GRID                           ON/OFF
C                      GRID COLOR                        A COLOR
C                      GRID PATTERN                      PATTERN
C                      ...LABEL                          A STRING OF CHA
C                      LABEL COLOR                       A COLOR
C                      LABEL SIZE                        A NUMBER
C                      LEGEND ...                        A STRING OF CHA
C                      LEGEND ... COLOR                  A COLOR
C                      LEGEND ... COORDINATES            2 NUMBERS
C                      LEGEND ... SIZE                   A NUMBER
C                      ...LIMITS                         2 NUMBERS
C                      LINES                             A LIST OF LINE
C                      LINE  COLORS                      A LIST OF COLOR
C                      LINE  THICKNESSES                 A LIST OF THICK
C                      ...LOG                            ON/OFF
C                      MARGIN COLOR                      A COLOR
C                      ...MAXIMUM                        A NUMBER
C                      ...MINIMUM                        A NUMBER
C                      NEGATE                            ON/OFF
C                      ORIGIN COORDINATES                3 NUMBERS
C                      PEDESTAL                          ON/OFF
C                      PEDESTAL COLOR                    A COLOR
C                      PEDESTAL HEIGHT                   A NUMBER
C                      PRE-SORT                          ON/OFF
C                      SEGMENT ... COLOR                 A COLOR
C                      SEGMENT ... COORDINATES           2 NUMBERS
C                      SEQUENCE                          ON/OFF
C                      ...TIC                            ON/OFF
CCCCCC                 ...TIC COLOR                      A COLOR
CCCCCC                 ...TIC DECIMALS                   A NUMBER
CCCCCC                 ...TIC COORDINATES                A LIST OF NUMBE
C                      ...TIC POSITION (JUSTIFICATION)   INSIDE/OUTSIDE/
C                      ...TIC SIZE                       A NUMBER
C                      ...TIC LABELS                     ON/OFF
C                      ...TIC LABEL COLOR                A COLOR
C                      ...TIC LABEL SIZE                 A NUMBER
C                      TITLE                             A STRING OF CHA
C                      TITLE COLOR                       A COLOR
C                      TITLE SIZE                        A NUMBER
C                      VISIBLE                           ON/OFF
C
C                      BAR SWITCH                        A SERIES OF ON/
C                      BAR WIDTH                         A SERIES OF NUM
C                      BAR BASE                          A SERIES OF NUM
C                      BAR BORDER COLOR                  A SERIES OF COL
C                      BAR BORDER THICKNESS              A SERIES OF NUM
C                      BAR BORDER LINE                   A SERIES OF LIN
C                      BAR FILL SWITCH                   A SERIES OF ON/
C                      BAR FILL COLOR                    A SERIES OF COL
C                      BAR PATTERN TYPE                  A SERIES OF PAT
C                      BAR PATTERN COLOR                 A SERIES OF COL
C                      BAR PATTERN SPACING               A SERIES OF NUM
C                      BAR PATTERN THICKNESS             A SERIES OF NUM
C                      BAR PATTERN LINE                  A SERIES OF LIN
C                      BAR TYPES                         A SERIES OF NUMBERS
C
C                      BAR EXPANSION FACTORS             2 NUMBERS
C
C                      REGION BASE                       A SERIES OF NUM
C                      REGION BORDER COLOR               A SERIES OF COL
C                      REGION BORDER THICKNESS           A SERIES OF NUM
C                      REGION BORDER LINE                A SERIES OF LIN
C                      REGION FILL SWITCH                A SERIES OF ON/
C                      REGION FILL COLOR                 A SERIES OF COL
C                      REGION PATTERN TYPE               A SERIES OF PAT
C                      REGION PATTERN COLOR              A SERIES OF COL
C                      REGION PATTERN SPACING            A SERIES OF NUM
C                      REGION PATTERN THICKNESS          A SERIES OF NUM
C                      REGION PATTERN LINE               A SERIES OF LIN
C
C                      TEXT BORDER COLOR                 A SERIES OF COL
C                      TEXT BORDER THICKNESS             A SERIES OF NUM
C                      TEXT BORDER LINE                  A SERIES OF LIN
C                      TEXT FILL SWITCH                  A SERIES OF ON/
C                      TEXT FILL COLOR                   A SERIES OF COL
C                      TEXT PATTERN TYPE                 A SERIES OF PAT
C                      TEXT PATTERN COLOR                A SERIES OF COL
C                      TEXT PATTERN SPACING              A SERIES OF NUM
C                      TEXT PATTERN THICKNESS            A SERIES OF NUM
C                      TEXT PATTERN LINE                 A SERIES OF LIN
C
C                      MAJOR ...TIC MARK NUMBER          A NUMBER
C                      MINOR ...TIC MARK NUMBER          A NUMBER
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --APRIL     1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JULY      1986.
C     UPDATED         --SEPTEMBER 1988. 3D PROJECTION (ORTHOGRAP./PERSPECT.)
C     UPDATED         --SEPTEMBER 1988. INCLUDE DPCO3D.INC
C     UPDATED         --APRIL     1992. BAR EXPANSION FACTORS ... ...
C     UPDATED         --AUGUST    1992. ADD SWITCHES FOR AUTOMATIC
C     UPDATED         --SEPTEMBER 1993. CHAR*4 FOR AUTOMATIC SWITCHES
C     UPDATED         --AUGUST    1999. ARGUMENT LIST TO MAIPC2
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGPC
      CHARACTER*4 IBUGP2
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED    SEPTEMBER 1993
      CHARACTER*4 ITIAUT
      CHARACTER*4 IX1AUT
      CHARACTER*4 IX2AUT
      CHARACTER*4 IX3AUT
      CHARACTER*4 IY1AUT
      CHARACTER*4 IY2AUT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCO3D.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
      IF(IBUGPC.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAINPC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGPC,IBUGP2
   53 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,60)INEGAT,IFOUND,IERROR
CCC60 FORMAT('INEGSW,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,81)IMPSW,IMPNR,IMPNC,IMPCO
   81 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   82 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IERASV,I3DPRO
   83 FORMAT('IERASV,I3DPRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   84 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IERASW
   85 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   86 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)PXMIN,PXMAX,PYMIN,PYMAX
   87 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      CALL MAIPC1(IBUGPC,IBUGP2,IBUGQ,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
     1IX1AUT,IX2AUT,IX3AUT,IY1AUT,IY2AUT,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
      CALL MAIPC2(IBUGPC,IBUGP2,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
CCCCC ADD FOLLOWING LINE AUGUST 1999.
     1IMPARG,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
     1ITIAUT,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
      CALL MAIPC3(IBUGPC,IBUGP2,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED    APRIL 1992
     1BARHEF,BARWEF,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
      CALL MAIPC4(IBUGPC,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPC.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAINPC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGPC,IBUGP2
 9013 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU
 9017 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9041)IMPSW,IMPNR,IMPNC,IMPCO
 9041 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9042 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IERASV,I3DPRO
 9043 FORMAT('IERASV,I3DPRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9044 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IERASW
 9045 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9046 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)PXMIN,PXMAX,PYMIN,PYMAX
 9047 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED    APRIL 1992
      WRITE(ICOUT,9048)BARHEF,BARWEF
 9048 FORMAT('BARHEF,BARWEF = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE MAIPC1(IBUGPC,IBUGP2,IBUGQ,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
     1IX1AUT,IX2AUT,IX3AUT,IY1AUT,IY2AUT,
     1IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAIPC1.
C              (THE   PC    AT THE END OF    MAIPC1   STANDS FOR PLOT CONTROL
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES
C              PLOT CONTROL COMMANDS (PART 1).
C              THE PLOT CONTROL COMMANDS SEARCHED FOR BY MAIPC1 ARE AS F
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JULY 1986.
C     UPDATED--JULY 1987        LEGEND HW
C     UPDATED--FEBRUARY      1988 FURTHER RESOLVE CONFLICT--MIN VS MIN PLOT
C                                                           AND MAX VS MAX PLO
C     UPDATED--MARCH     1988.  FURTHER RESOLVE CONFLICT--MIN VS MIN PLOT
C                                                         AND MAX VS MAX PLO
C     UPDATED--SEPTEMBER 1988.  MOVE EYE/ORIGIN/PEDESTAL COMMANDS
C                               TO MAIPC4 FOR GENERAL 3-D.
C     UPDATED         --SEPTEMBER 1988.  CHANGE 'BACK' TO 'BACKGROU'
C     UPDATED         --DECEMBER  1988.  LABEL AND LEGEND DEFAULT WIDTH
C     UPDATED         --FEBRUARY  1989.  ADD MANY ATTRIBUTE COMMANDS (ALAN)
C     UPDATED         --MAY       1989.  DES. OF EXP. WIDTH/DEPTH/HOR. AXIS
C     UPDATED         --JULY      1989.  ...LABEL DISPLACEMENT
C     UPDATED         --FEBRUARY  1992. FIX LEGEND DIRECTION CONFLICT
C     UPDATED         --APRIL     1992. IDEXHO TO IDEXHA
C     UPDATED         --AUGUST    1992. ADD SWITCHES FOR AUTOMATIC
C     UPDATED         --AUGUST    1992. BOX SHADOW HEIGHT/WIDTH
C     UPDATED         --AUGUST    1992. BOX FILL COLOR
C     UPDATED         --AUGUST    1992. BOX FILL PATTERN
C     UPDATED         --AUGUST    1992. BOX FILL THICK
C     UPDATED         --AUGUST    1992. BOX FILL GAP
C     UPDATED         --MARCH     1993. BUG IN CALL TO DPBOTH
C     UPDATED         --SEPTEMBER 1993. LOWER CASE LABELS
C     UPDATED         --SEPTEMBER 1993. LOWER CASE LEGENDS
C     UPDATED         --SEPTEMBER 1993. 3-D FRAME SWITCH
C     UPDATED         --SEPTEMBER 1993. CHAR*4 FOR AUTOMATIC SWITCHES
C     UPDATED         --OCTOBER   1993. BACKGROUND COLOR SETS THE 
C                                       MARGIN COLOR AS WELL
C     UPDATED         --DECEMBER  1994. EXACT CHARACTER MAPPING
C     UPDATED         --JANUARY   1995. FIX DEFAULT CHAR SIZE
C     UPDATED         --APRIL     1995. CHECK FOR COMMAND CONFLICT
C     UPDATED         --AUGUST    1995. SEGMENT PATTERN, FRAME PATTERN,
C                                       BUG (DASH2, ETC)
C     UPDATED         --NOVEMBER  1997. CALL TO DPLIM
C     UPDATED         --JANUARY   1998. NAME CONFLICTS FOR MAXI, MINI
C     UPDATED         --FEBRUARY  1998. LINE/CHAR <SAVE/RESTORE>
C     UPDATED         --OCTOBER   1999. LABEL JUSTIFICIATION
C     UPDATED         --OCTOBER   1999. LABEL OFFSET
C     UPDATED         --DECEMBER  1999. LEGEND UNITS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGPC
      CHARACTER*4 IBUGP2
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED   SEPTEMBER 1993
      CHARACTER*4 IX1AUT
      CHARACTER*4 IX2AUT
      CHARACTER*4 IX3AUT
      CHARACTER*4 IY1AUT
      CHARACTER*4 IY2AUT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING DES. OF EXP. LINE WAS ADDED MAY 1989
      INCLUDE 'DPCODE.INC'
CCCCC THE FOLLOWING 3D LINE WAS ADDED SEPTEMBER 1993
      INCLUDE 'DPCO3D.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGPC.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAIPC1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGPC,IBUGP2
   53 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,60)INEGAT,IFOUND,IERROR
CCC60 FORMAT('INEGSW,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,81)IMPSW,IMPNR,IMPNC,IMPCO
   81 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   82 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IERASV
   83 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   84 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IERASW
   85 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   86 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)PXMIN,PXMAX,PYMIN,PYMAX
   87 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
C               **************************************
C               **  TREAT THE ARROW ... COLOR CASE  **
C               **************************************
C
      IF(ICOM.EQ.'ARRO')GOTO100
      GOTO199
C
  100 CONTINUE
      CALL DPARCL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXARR,IARRCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  199 CONTINUE
C
C
C               ****************************************
C               **  TREAT THE ARROW ... PATTERN CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'ARRO')GOTO110
      GOTO119
C
  110 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPARPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
      CALL DPARPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
     1MAXARR,IARRPA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  119 CONTINUE
C
C
C               ******************************************
C               **  TREAT THE ARROW ... THICKNESS CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'ARRO')GOTO120
      GOTO129
C
  120 CONTINUE
      CALL DPARTH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXARR,PARRTH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
  129 CONTINUE
C
C
C               ********************************************
C               **  TREAT THE ARROW ... COORDINATES CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'ARRO')GOTO200
      GOTO299
C
  200 CONTINUE
      CALL DPARCO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXARR,PARRXC,PARRYC,NUMARR,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  299 CONTINUE
C
C               ***************************************
C               **  TREAT THE BACKGROUND COLOR CASE  **
C               ***************************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'GROU')GOTO300
      GOTO399
C
  300 CONTINUE
      CALL DPBACL(IHARG,NUMARG,IDEFBK,IBACCO,IFOUND,IERROR)
CCCCC OCTOBER 1993.  HAVE THE MARGIN BE THE SAME AS THE BACKGROUND 
CCCCC (USER CAN OVERRIDE WITH SUBSEQUENT MARGIN COLOR COMMAND)
      IF(IERROR.EQ.'NO')IMARCO=IBACCO
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  399 CONTINUE
C
C               ***************************
C               **  TREAT THE BELL CASE  **
C               ***************************
C
      IF(ICOM.EQ.'BELL')GOTO400
      GOTO499
C
  400 CONTINUE
      CALL DPBELL(IHARG,NUMARG,IBELSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  499 CONTINUE
C
C               *************************************************
C               **  TREAT THE BOX ... CORNER COORDINATES CASE  **
C               *************************************************
C
      IF(ICOM.EQ.'BOX')GOTO500
      GOTO599
C
  500 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')
     1GOTO510
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')
     1GOTO510
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CORN'.AND.
     1IHARG(2).EQ.'COOR')GOTO510
      IF(NUMARG.GE.3.AND.IHARG(2).EQ.'CORN'.AND.
     1IHARG(3).EQ.'COOR')GOTO510
      GOTO599
  510 CONTINUE
      CALL DPBOCC(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXBOX,PBOXXC,PBOXYC,NUMBOX,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  599 CONTINUE
C
C               ************************************
C               **  TREAT THE BOX ... COLOR CASE  **
C               ************************************
 
CCCCC AUGUST 1992.  THIS WILL SET THE BORDER COLOR (NOT THE FILL
CCCCC COLOR, USE IBOBCO, NOT IBOFCO)
C
      IF(ICOM.EQ.'BOX')GOTO600
      GOTO699
C
  600 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')
     1GOTO610
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO'.AND.IHARG(1).NE.'FILL')
     1GOTO610
      GOTO699
  610 CONTINUE
CCCCC CALL DPBOCL(IHARG,IARGT,IARG,NUMARG,IDEFXC,
CCCCC1MAXBOX,IBOFCO,IFOUND,IERROR)
      CALL DPBOCL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXBOX,IBOBCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  699 CONTINUE
C
C
C               **************************************
C               **  TREAT THE BOX ... PATTERN CASE  **
C               **************************************
C
CCCCC AUGUST 1992.  THIS COMMAND SETS THE LINE PATTERN FOR THE
CCCCC BOX BORDER.  SET IBOBPA RATHER THAN IBOFPA.
CCCCC IF(ICOM.EQ.'BOX')GOTO620
      IF(ICOM.EQ.'BOX')GOTO620
      GOTO629
C
  620 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')
     1GOTO625
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PATT'.AND.IHARG(1).NE.'FILL')
     1GOTO625
      GOTO629
  625 CONTINUE
CCCCC CALL DPBOPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
CCCCC1MAXBOX,IBOFPA,IFOUND,IERROR)
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPBOPA(IHARG,IARGT,IARG,NUMARG,IDEFFI,
      CALL DPBOPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFFI,
     1MAXBOX,IBOBPA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  629 CONTINUE
C
C               ****************************************
C               **  TREAT THE BOX ... THICKNESS CASE  **
C               ****************************************
C
CCCCC AUGUST 1992.  THIS COMMAND SETS THE BOX BORDER THICKNESS.
CCCCC SET PBOPTH RATHER THAN PBOFTH.
      IF(ICOM.EQ.'BOX')GOTO630
      GOTO639
C
  630 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')
     1GOTO635
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'THIC'.AND.IHARG(1).NE.'FILL')
     1GOTO635
      GOTO639
  635 CONTINUE
      CALL DPBOTH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
CCCCC1MAXBOX,PBOFTH,IFOUND,IERROR)
     1MAXBOX,PBOPTH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  639 CONTINUE
C
CCCCC FOLLOWING COMMANDS ADDED AUGUST 1992 (... FILL ...)
C               *****************************************
C               **  TREAT THE BOX ... FILL COLOR CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'COLO')THEN
              CALL DPBOFC(IHARG,IARGT,IARG,NUMARG,IDEFXC,
     1                    MAXBOX,IBOFCO,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'COLO')THEN
              CALL DPBOFC(IHARG,IARGT,IARG,NUMARG,IDEFXC,
     1                    MAXBOX,IBOFCO,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
      ENDIF
C
C
C               ********************************************
C               **  TREAT THE BOX ... FILL PATTTERN CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'PATT')THEN
              CALL DPBOFP(IHARG,IARGT,IARG,NUMARG,IDEFFI,
     1                    MAXBOX,IBOFPA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'PATT')THEN
              CALL DPBOFP(IHARG,IARGT,IARG,NUMARG,IDEFFI,
     1                    MAXBOX,IBOFPA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
      ENDIF
C
C
C               ********************************************
C               **  TREAT THE BOX ... FILL LINE     CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'LINE')THEN
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC         CALL DPBOFL(IHARG,IARGT,IARG,NUMARG,IDEFPA,
              CALL DPBOFL(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
     1                    MAXBOX,IBOPPA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'LINE')THEN
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC         CALL DPBOFL(IHARG,IARGT,IARG,NUMARG,IDEFPA,
              CALL DPBOFL(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
     1                    MAXBOX,IBOPPA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
      ENDIF
C
C               *********************************************
C               **  TREAT THE BOX ... FILL THICKNESS CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'THIC')THEN
              CALL DPBOFT(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1                    MAXBOX,PBOFTH,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'THIC')THEN
              CALL DPBOFT(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1                    MAXBOX,PBOFTH,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
      ENDIF
C
C               *********************************************
C               **  TREAT THE BOX ... FILL GAP       CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(1).EQ.'FILL'.AND.IHARG(2).EQ.'GAP')THEN
              CALL DPBOFG(IHARG,IARGT,IARG,ARG,NUMARG,PDEFGA,
     1                    MAXBOX,PBOPGA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
         IF(NUMARG.GE.3)THEN
            IF(IHARG(2).EQ.'FILL'.AND.IHARG(3).EQ.'GAP')THEN
              CALL DPBOFG(IHARG,IARGT,IARG,ARG,NUMARG,PDEFGA,
     1                    MAXBOX,PBOPGA,IFOUND,IERROR)
              IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1992
C               ****************************************
C               **  TREAT THE BOX ... SHADOW HW CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'BOX')THEN
C
         IF(NUMARG.GE.1)THEN
            IF(IHARG(1).EQ.'SHAD')THEN
               CALL DPBSHW(IHARG,IARGT,IARG,ARG,NUMARG,PDEFSH,PDEFSW,
     1         MAXBOX,PBOSHE,PBOSWI,IFOUND,IERROR)
               IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
C
         IF(NUMARG.GE.2)THEN
            IF(IHARG(2).EQ.'SHAD')THEN
               CALL DPBSHW(IHARG,IARGT,IARG,ARG,NUMARG,PDEFSH,PDEFSW,
     1         MAXBOX,PBOSHE,PBOSWI,IFOUND,IERROR)
               IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
            ENDIF
         ENDIF
C
      ENDIF
C
C               *************************************************
C               **  TREAT THE FRAME (CORNER) COORDINATES CASE  **
C               *************************************************
C
      IF(ICOM.EQ.'FRAM')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CORN'.AND.
     1IHARG(2).EQ.'COOR')GOTO1211
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')
     1GOTO1230
      GOTO1299
 1211 CONTINUE
      ISHIFT=1
      GOTO1220
 1220 CONTINUE
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      GOTO1230
 1230 CONTINUE
      CALL DPFRCC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PXMIN,PXMAX,PYMIN,PYMAX,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1299 CONTINUE
C
C               **********************************
C               **  TREAT THE FRAME COLOR CASE  **
C               **********************************
C
      IF(ICOM.EQ.'XFRA')GOTO1300
      IF(ICOM.EQ.'X1FR')GOTO1300
      IF(ICOM.EQ.'X2FR')GOTO1300
      IF(ICOM.EQ.'YFRA')GOTO1300
      IF(ICOM.EQ.'Y1FR')GOTO1300
      IF(ICOM.EQ.'Y2FR')GOTO1300
      IF(ICOM.EQ.'XYFR')GOTO1300
      IF(ICOM.EQ.'YXFR')GOTO1300
      IF(ICOM.EQ.'FRAM')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')
     1GOTO1310
      GOTO1399
 1310 CONTINUE
      CALL DPFRCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1FCO,IX2FCO,IY1FCO,IY2FCO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1399 CONTINUE
C
C
C               ************************************
C               **  TREAT THE FRAME PATTERN CASE  **
C               ************************************
C
      IF(ICOM.EQ.'XFRA')GOTO1320
      IF(ICOM.EQ.'X1FR')GOTO1320
      IF(ICOM.EQ.'X2FR')GOTO1320
      IF(ICOM.EQ.'YFRA')GOTO1320
      IF(ICOM.EQ.'Y1FR')GOTO1320
      IF(ICOM.EQ.'Y2FR')GOTO1320
      IF(ICOM.EQ.'XYFR')GOTO1320
      IF(ICOM.EQ.'YXFR')GOTO1320
      IF(ICOM.EQ.'FRAM')GOTO1320
      GOTO1329
C
 1320 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')
     1GOTO1325
      GOTO1329
 1325 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 (TO RECOGNIZE DASH2, ETC.)
CCCCC CALL DPFRPA(ICOM,IHARG,NUMARG,
      CALL DPFRPA(ICOM,IHARG,IHARG2,NUMARG,
     1IDEFPA,
     1IX1FPA,IX2FPA,IY1FPA,IY2FPA,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1329 CONTINUE
C
C               **************************************
C               **  TREAT THE FRAME THICKNESS CASE  **
C               **************************************
C
      IF(ICOM.EQ.'XFRA')GOTO1330
      IF(ICOM.EQ.'X1FR')GOTO1330
      IF(ICOM.EQ.'X2FR')GOTO1330
      IF(ICOM.EQ.'YFRA')GOTO1330
      IF(ICOM.EQ.'Y1FR')GOTO1330
      IF(ICOM.EQ.'Y2FR')GOTO1330
      IF(ICOM.EQ.'XYFR')GOTO1330
      IF(ICOM.EQ.'YXFR')GOTO1330
      IF(ICOM.EQ.'FRAM')GOTO1330
      GOTO1339
C
 1330 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')
     1GOTO1335
      GOTO1339
 1335 CONTINUE
      CALL DPFRTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PFRATH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1339 CONTINUE
C
C               ****************************
C               **  TREAT THE FRAME CASE  **
C               ****************************
C
      IF(ICOM.EQ.'XFRA')GOTO1400
      IF(ICOM.EQ.'X1FR')GOTO1400
      IF(ICOM.EQ.'X2FR')GOTO1400
      IF(ICOM.EQ.'YFRA')GOTO1400
      IF(ICOM.EQ.'Y1FR')GOTO1400
      IF(ICOM.EQ.'Y2FR')GOTO1400
      IF(ICOM.EQ.'XYFR')GOTO1400
      IF(ICOM.EQ.'YXFR')GOTO1400
      IF(ICOM.EQ.'FRAM')GOTO1400
CCCCC THE FOLLOWING LINE WAS ADDED (FOR 3-D)    SEPTEMBER 1993
      IF(ICOM.EQ.'3DFR')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      CALL DPFRAM(ICOM,IHARG,NUMARG,
     1IX1FSW,IX2FSW,IY1FSW,IY2FSW,
CCCCC THE FOLLOWING LINE WAS ADDED (FOR 3-D)    SEPTEMBER 1993
     1FRAM3D,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1499 CONTINUE
C
C               **************************************
C               **  TREAT THE GRID  THICKNESS CASE  **
C               **************************************
C
      IF(ICOM.EQ.'XGRI')GOTO1630
      IF(ICOM.EQ.'YGRI')GOTO1630
      IF(ICOM.EQ.'XYGR')GOTO1630
      IF(ICOM.EQ.'YXGR')GOTO1630
      IF(ICOM.EQ.'GRID')GOTO1630
      GOTO1639
C
 1630 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1635
      GOTO1639
 1635 CONTINUE
      CALL DPGRTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PVGRTH,PHGRTH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1639 CONTINUE
C
C               ***************************
C               **  TREAT THE GRID CASE  **
C               ***************************
C
      IF(ICOM.EQ.'XGRI')GOTO1500
      IF(ICOM.EQ.'YGRI')GOTO1500
      IF(ICOM.EQ.'XYGR')GOTO1500
      IF(ICOM.EQ.'YXGR')GOTO1500
      IF(ICOM.EQ.'GRID')GOTO1500
      GOTO1599
C
 1500 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1599
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1599
      CALL DPGRID(ICOM,IHARG,NUMARG,IVGRSW,IHGRSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1599 CONTINUE
C
C               **********************************
C               **  TREAT THE GRID  COLOR CASE  **
C               **********************************
C
      IF(ICOM.EQ.'XGRI')GOTO1600
      IF(ICOM.EQ.'YGRI')GOTO1600
      IF(ICOM.EQ.'XYGR')GOTO1600
      IF(ICOM.EQ.'YXGR')GOTO1600
      IF(ICOM.EQ.'GRID')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1610
      GOTO1699
 1610 CONTINUE
      CALL DPGRCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IVGRCO,IHGRCO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1699 CONTINUE
C
C               ***********************************
C               **  TREAT THE GRID PATTERN CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'XGRI')GOTO1620
      IF(ICOM.EQ.'YGRI')GOTO1620
      IF(ICOM.EQ.'XYGR')GOTO1620
      IF(ICOM.EQ.'YXGR')GOTO1620
      IF(ICOM.EQ.'GRID')GOTO1620
      GOTO1629
C
 1620 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1625
      GOTO1629
 1625 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPGRPA(ICOM,IHARG,NUMARG,
      CALL DPGRPA(ICOM,IHARG,IHARG2,NUMARG,
     1IDEFPA,
     1IVGRPA,IHGRPA,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1629 CONTINUE
C
C               ****************************************
C               **  TREAT THE LABEL     FONT   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1810
      IF(ICOM.EQ.'XLAB')GOTO1810
      IF(ICOM.EQ.'X1LA')GOTO1810
      IF(ICOM.EQ.'X2LA')GOTO1810
      IF(ICOM.EQ.'X3LA')GOTO1810
      IF(ICOM.EQ.'YLAB')GOTO1810
      IF(ICOM.EQ.'Y1LA')GOTO1810
      IF(ICOM.EQ.'Y2LA')GOTO1810
      GOTO1819
C
 1810 CONTINUE
      CALL DPLAFO(ICOM,IHARG,NUMARG,
     1IDEFFO,
     1IX1LFO,IX2LFO,IX3LFO,IY1LFO,IY2LFO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1819 CONTINUE
C
C
C               ****************************************
C               **  TREAT THE LABEL     CASE   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1820
      IF(ICOM.EQ.'XLAB')GOTO1820
      IF(ICOM.EQ.'X1LA')GOTO1820
      IF(ICOM.EQ.'X2LA')GOTO1820
      IF(ICOM.EQ.'X3LA')GOTO1820
      IF(ICOM.EQ.'YLAB')GOTO1820
      IF(ICOM.EQ.'Y1LA')GOTO1820
      IF(ICOM.EQ.'Y2LA')GOTO1820
      GOTO1829
C
 1820 CONTINUE
      CALL DPLACA(ICOM,IHARG,NUMARG,
     1IDEFCA,
     1IX1LCA,IX2LCA,IX3LCA,IY1LCA,IY2LCA,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1829 CONTINUE
C
C
C               ****************************************
C               **  TREAT THE LABEL     FILL   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1830
      IF(ICOM.EQ.'XLAB')GOTO1830
      IF(ICOM.EQ.'X1LA')GOTO1830
      IF(ICOM.EQ.'X2LA')GOTO1830
      IF(ICOM.EQ.'X3LA')GOTO1830
      IF(ICOM.EQ.'YLAB')GOTO1830
      IF(ICOM.EQ.'Y1LA')GOTO1830
      IF(ICOM.EQ.'Y2LA')GOTO1830
      GOTO1839
C
 1830 CONTINUE
      CALL DPLAFI(ICOM,IHARG,NUMARG,
     1IDEFFI,
     1IX1LFI,IX2LFI,IX3LFI,IY1LFI,IY2LFI,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1839 CONTINUE
C
C               ****************************************
C               **  TREAT THE LABEL     JUST   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO11810
      IF(ICOM.EQ.'XLAB')GOTO11810
      IF(ICOM.EQ.'X1LA')GOTO11810
      IF(ICOM.EQ.'X2LA')GOTO11810
      IF(ICOM.EQ.'X3LA')GOTO11810
      IF(ICOM.EQ.'YLAB')GOTO11810
      IF(ICOM.EQ.'Y1LA')GOTO11810
      IF(ICOM.EQ.'Y2LA')GOTO11810
      GOTO11819
C
11810 CONTINUE
      CALL DPLAJU(ICOM,IHARG,NUMARG,
     1IDEFJU,
     1IX1LJU,IX2LJU,IX3LJU,IY1LJU,IY2LJU,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11819 CONTINUE
C
C
C               ****************************************
C               **  TREAT THE LABEL  THICKNESS CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1840
      IF(ICOM.EQ.'XLAB')GOTO1840
      IF(ICOM.EQ.'X1LA')GOTO1840
      IF(ICOM.EQ.'X2LA')GOTO1840
      IF(ICOM.EQ.'X3LA')GOTO1840
      IF(ICOM.EQ.'YLAB')GOTO1840
      IF(ICOM.EQ.'Y1LA')GOTO1840
      IF(ICOM.EQ.'Y2LA')GOTO1840
      GOTO1849
C
 1840 CONTINUE
      CALL DPLATH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PX1LTH,PX2LTH,PX3LTH,PY1LTH,PY2LTH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1849 CONTINUE
C
CCCCC THE FOLLOWING SECTIONS WAS ADDED JULY 1989
C               ****************************************
C               **  TREAT THE LABEL  DISPLACEMENT CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1850
      IF(ICOM.EQ.'XLAB')GOTO1850
      IF(ICOM.EQ.'X1LA')GOTO1850
      IF(ICOM.EQ.'X2LA')GOTO1850
      IF(ICOM.EQ.'X3LA')GOTO1850
      IF(ICOM.EQ.'YLAB')GOTO1850
      IF(ICOM.EQ.'Y1LA')GOTO1850
      IF(ICOM.EQ.'Y2LA')GOTO1850
      GOTO1859
C
 1850 CONTINUE
      CALL DPLADS(ICOM,IHARG,ARG,NUMARG,
     1PDEFDS,
     1PX1LDS,PX2LDS,PX3LDS,PY1LDS,PY2LDS,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1859 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED OCTOBER 1999
C               ****************************************
C               **  TREAT THE LABEL  OFFSET    CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO11850
      IF(ICOM.EQ.'XLAB')GOTO11850
      IF(ICOM.EQ.'X1LA')GOTO11850
      IF(ICOM.EQ.'X2LA')GOTO11850
      IF(ICOM.EQ.'X3LA')GOTO11850
      IF(ICOM.EQ.'YLAB')GOTO11850
      IF(ICOM.EQ.'Y1LA')GOTO11850
      IF(ICOM.EQ.'Y2LA')GOTO11850
      GOTO11859
C
11850 CONTINUE
      CALL DPLAOF(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFOF,
     1PX1LOF,PX2LOF,PX3LOF,PY1LOF,PY2LOF,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11859 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED NOVEMBER 1999
C               ****************************************
C               **  TREAT THE LABEL  ANGLE     CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO11860
      IF(ICOM.EQ.'XLAB')GOTO11860
      IF(ICOM.EQ.'X1LA')GOTO11860
      IF(ICOM.EQ.'X2LA')GOTO11860
      IF(ICOM.EQ.'X3LA')GOTO11860
      IF(ICOM.EQ.'YLAB')GOTO11860
      IF(ICOM.EQ.'Y1LA')GOTO11860
      IF(ICOM.EQ.'Y2LA')GOTO11860
      GOTO11869
C
11860 CONTINUE
      CALL DPLAAN(ICOM,IHARG,IARGT,ARG,NUMARG,
     1ADEFAN,
     1PX1LAN,PX2LAN,PX3LAN,PY1LAN,PY2LAN,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11869 CONTINUE
C
C               ****************************************
C               **  TREAT THE LABEL DIRECTION  CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO11870
      IF(ICOM.EQ.'XLAB')GOTO11870
      IF(ICOM.EQ.'X1LA')GOTO11870
      IF(ICOM.EQ.'X2LA')GOTO11870
      IF(ICOM.EQ.'X3LA')GOTO11870
      IF(ICOM.EQ.'YLAB')GOTO11870
      IF(ICOM.EQ.'Y1LA')GOTO11870
      IF(ICOM.EQ.'Y2LA')GOTO11870
      GOTO11879
C
11870 CONTINUE
      CALL DPLADI(ICOM,IHARG,NUMARG,
     1IDEFDI,
     1IX1LDI,IX2LDI,IX3LDI,IY1LDI,IY2LDI,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11879 CONTINUE
C
C               ****************************
C               **  TREAT THE LABEL CASE  **
C               ****************************
C
      IF(ICOM.EQ.'LABE')GOTO1700
      IF(ICOM.EQ.'XLAB')GOTO1700
      IF(ICOM.EQ.'X1LA')GOTO1700
      IF(ICOM.EQ.'X2LA')GOTO1700
      IF(ICOM.EQ.'X3LA')GOTO1700
      IF(ICOM.EQ.'YLAB')GOTO1700
      IF(ICOM.EQ.'Y1LA')GOTO1700
      IF(ICOM.EQ.'Y2LA')GOTO1700
      GOTO1799
C
 1700 CONTINUE
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
CCCCC CALL DPLAB(IANS,IWIDTH,IHARG,NUMARG,
CCCCC THE FOLLOWING LINE WAS AUGMENTED    SEPTEMBER 1993
CCCCC SO AS TO ALLOW LOWER CASE           SEPTEMBER 1993
CCCCC CALL DPLAB(IANS,IWIDTH,IHARG,IHARG2,NUMARG,
      CALL DPLAB(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
CCCCC THE FOLLOWING 5 LINES WERE AUGMENTED AUGUST 1992
CCCCC1IX1LTE,NCX1LA,
CCCCC1IX2LTE,NCX2LA,
CCCCC1IX3LTE,NCX3LA,
CCCCC1IY1LTE,NCY1LA,
CCCCC1IY2LTE,NCY2LA,
     1IX1LTE,NCX1LA,IX1AUT,
     1IX2LTE,NCX2LA,IX2AUT,
     1IX3LTE,NCX3LA,IX3AUT,
     1IY1LTE,NCY1LA,IY1AUT,
     1IY2LTE,NCY2LA,IY2AUT,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1799 CONTINUE
C
C               ****************************************
C               **  TREAT THE LABEL     COLORS CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1800
      IF(ICOM.EQ.'XLAB')GOTO1800
      IF(ICOM.EQ.'X1LA')GOTO1800
      IF(ICOM.EQ.'X2LA')GOTO1800
      IF(ICOM.EQ.'X3LA')GOTO1800
      IF(ICOM.EQ.'YLAB')GOTO1800
      IF(ICOM.EQ.'Y1LA')GOTO1800
      IF(ICOM.EQ.'Y2LA')GOTO1800
      GOTO1899
C
 1800 CONTINUE
      CALL DPLACL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1LCO,IX2LCO,IX3LCO,IY1LCO,IY2LCO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1899 CONTINUE
C
C               ****************************************
C               **  TREAT THE LABEL     SIZES CASE    **
C               ****************************************
C
      IF(ICOM.EQ.'LABE')GOTO1900
      IF(ICOM.EQ.'XLAB')GOTO1900
      IF(ICOM.EQ.'X1LA')GOTO1900
      IF(ICOM.EQ.'X2LA')GOTO1900
      IF(ICOM.EQ.'X3LA')GOTO1900
      IF(ICOM.EQ.'YLAB')GOTO1900
      IF(ICOM.EQ.'Y1LA')GOTO1900
      IF(ICOM.EQ.'Y2LA')GOTO1900
      GOTO1999
C
 1900 CONTINUE
      CALL DPLASZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1LHE,PX1LWI,PX1LVG,PX1LHG,
     1PX2LHE,PX2LWI,PX2LVG,PX2LHG,
     1PX3LHE,PX3LWI,PX3LVG,PX3LHG,
     1PY1LHE,PY1LWI,PY1LVG,PY1LHG,
     1PY2LHE,PY2LWI,PY2LVG,PY2LHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1999 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... FONT   CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2110
      GOTO2119
C
 2110 CONTINUE
      CALL DPLEFO(IHARG,IARGT,IARG,NUMARG,IDEFFO,
     1MAXLEG,ILEGFO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2119 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... CASE   CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2120
      GOTO2129
C
 2120 CONTINUE
      CALL DPLECA(IHARG,IARGT,IARG,NUMARG,IDEFCA,
     1MAXLEG,ILEGCA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2129 CONTINUE
C
C               ***********************************************
C               **  TREAT THE LEGEND ... JUSTIFICATION CASE  **
C               ***********************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2130
      GOTO2139
C
 2130 CONTINUE
      CALL DPLEJU(IHARG,IARGT,IARG,NUMARG,IDEFJU,
     1MAXLEG,ILEGJU,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2139 CONTINUE
C
C               *******************************************
C               **  TREAT THE LEGEND ... DIRECTION CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2140
      GOTO2149
C
 2140 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED FEBRUARY 1992
CCCCC CALL DPLEDI(IHARG,IARGT,IARG,NUMARG,IDEFDI,
      CALL DPLEDI(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFDI,
     1MAXLEG,ILEGDI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2149 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... UNITS  CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')THEN
        CALL DPLEUN(IHARG,IARGT,IARG,NUMARG,IDEFUZ,
     1    MAXLEG,ILEGUN,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C               ****************************************
C               **  TREAT THE LEGEND ... FILL   CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2150
      GOTO2159
C
 2150 CONTINUE
      CALL DPLEFI(IHARG,IARGT,IARG,NUMARG,IDEFFI,
     1MAXLEG,ILEGFI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2159 CONTINUE
C
C               *******************************************
C               **  TREAT THE LEGEND ... THICKNESS CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2160
      GOTO2169
C
 2160 CONTINUE
      CALL DPLETH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXLEG,PLEGTH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2169 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... ANGLE  CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2170
      GOTO2179
C
 2170 CONTINUE
      CALL DPLEAN(IHARG,IARGT,IARG,ARG,NUMARG,ADEFAN,
     1MAXLEG,ALEGAN,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2179 CONTINUE
C
C               *********************************
C               **  TREAT THE LEGEND ... CASE  **
C               *********************************
C
      IF(ICOM.EQ.'LEGE')GOTO2000
      GOTO2099
C
 2000 CONTINUE
CCCCC THE FOLLOWING LINE WAS AUGMENTED     SEPTEMBER 1993
CCCCC SO AS TO ALLOW LOWER CASE            SEPTEMBER 1993
CCCCC CALL DPLEG(IHARG,IARG,ARG,IARGT,NUMARG,IANS,IWIDTH,
      CALL DPLEG(IHARG,IARG,ARG,IARGT,NUMARG,IANS,IANSLC,IWIDTH,
     1ILEGNA,ILEGST,ILEGSP,NUMLEG,MAXLEG,
     1ILEGTE,NCLEG,MXCLEG,IFOUND,IERROR,IBUGP2)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2099 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... COLORS CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2100
      GOTO2199
C
 2100 CONTINUE
      CALL DPLECL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXLEG,ILEGCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2199 CONTINUE
C
C               *********************************************
C               **  TREAT THE LEGEND ... COORDINATES CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2200
      GOTO2299
C
 2200 CONTINUE
      CALL DPLECO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXLEG,PLEGXC,PLEGYC,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2299 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... SIZES  CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO2300
      GOTO2399
C
 2300 CONTINUE
      CALL DPLESZ(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1MAXLEG,
     1PLEGHE,PLEGWI,PLEGVG,PLEGHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2399 CONTINUE
C
C               ********************************
C               **  TREAT THE ...LIMITS CASE  **
C               ********************************
C
      IF(ICOM.EQ.'XLIM')GOTO2400
      IF(ICOM.EQ.'X1LI')GOTO2400
      IF(ICOM.EQ.'X2LI')GOTO2400
      IF(ICOM.EQ.'YLIM')GOTO2400
      IF(ICOM.EQ.'Y1LI')GOTO2400
      IF(ICOM.EQ.'Y2LI')GOTO2400
      IF(ICOM.EQ.'XYLI')GOTO2400
      IF(ICOM.EQ.'YXLI')GOTO2400
      IF(ICOM.EQ.'LIMI')GOTO2400
      IF(ICOM.EQ.'LIM ')GOTO2400
      GOTO2499
C
 2400 CONTINUE
      CALL DPLIM(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MIN,GX1MAX,GY1MIN,GY1MAX,
     1GX2MIN,GX2MAX,GY2MIN,GY2MAX,
     1FX1MIN,FX1MAX,FY1MIN,FY1MAX,
     1FX2MIN,FX2MAX,FY2MIN,FY2MAX,
     1IX1MIN,IX1MAX,IY1MIN,IY1MAX,
     1IX2MIN,IX2MAX,IY2MIN,IY2MAX,
CCCCC ADD FOLLOWING 2 LINES.  NOVEMBER 1997
     1FX1MNZ,FX1MXZ,FX2MNZ,FX2MXZ,
     1FY1MNZ,FY1MXZ,FY2MNZ,FY2MXZ,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2499 CONTINUE
C
C               ***********************************
C               **  TREAT THE LINES COLORS CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'COLO')GOTO2500
      GOTO2599
C
 2500 CONTINUE
      CALL DPLICL(IHARG,NUMARG,IDEFCO,MAXLIN,ILINCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2599 CONTINUE
C
C               ****************************************
C               **  TREAT THE LINE    THICKNESS CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'THIC')GOTO2600
      GOTO2699
C
 2600 CONTINUE
      CALL DPLITH(IHARG,IARGT,ARG,NUMARG,PDEFLT,MAXLIN,PLINTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2699 CONTINUE
C
C               ****************************
C               **  TREAT THE LINES CASE  **
C               ****************************
C
      IF(ICOM.EQ.'LINE'.AND.ICOM2.NE.'AR  ')GOTO2700
      GOTO2799
C
 2700 CONTINUE
CCCCC CALL DPLINE(IHARG,IHARG2,NUMARG,MAXLIN,ILINPA,IFOUND,IERROR)
CCCCC ARGUMENT LIST AUGMENTED FEBRUARY 1998.
      CALL DPLINE(IHARG,IHARG2,NUMARG,MAXLIN,ILINPA,ILINPO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2799 CONTINUE
C
C               *****************************
C               **  TREAT THE ...LOG CASE  **
C               *****************************
C
      IF(ICOM.EQ.'XLOG')GOTO2800
      IF(ICOM.EQ.'X1LO')GOTO2800
      IF(ICOM.EQ.'X2LO')GOTO2800
      IF(ICOM.EQ.'YLOG')GOTO2800
      IF(ICOM.EQ.'Y1LO')GOTO2800
      IF(ICOM.EQ.'Y2LO')GOTO2800
      IF(ICOM.EQ.'XYLO'.AND.ICOM2.EQ.'G   ')GOTO2800
      IF(ICOM.EQ.'YXLO'.AND.ICOM2.EQ.'G   ')GOTO2800
      IF(ICOM.EQ.'LOG ')GOTO2800
      IF(ICOM.EQ.'LOGL')GOTO2800
      GOTO2899
C
 2800 CONTINUE
CCCCC APRIL 1995.  CHECK FOR LOG LOGISTIC PROB PLOT, LOG LOGISTIC PPCC
CCCCC PLOT (ALSO ENTERED AS LOGLOGISTIC PROB PLOT)
CCCCC SEPTEMBER 2001.  CHECK FOR LOG DOUBLE EXPO PROB PLOT,
CCCCC LOG DOUBLE EPXO PPCC PLOT
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PROB')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PROB')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PROB')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PROB')GOTO2899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PPCC')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PPCC')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'PPCC')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'PPCC')GOTO2899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'KOLM')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'KOLM')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'KOLM')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'KOLM')GOTO2899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'KS  ')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'KS  ')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'KS  ')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'KS  ')GOTO2899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHI ')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CHI ')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'CHI ')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'CHI ')GOTO2899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHIS')GOTO2899
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CHIS')GOTO2899
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'CHIS')GOTO2899
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'CHIS')GOTO2899
C
      CALL DPTISC(ICOM,IHARG,NUMARG,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2899 CONTINUE
C
C               ***********************************
C               **  TREAT THE MARGIN COLOR CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'MARG'.AND.IHARG(1).EQ.'COOR')GOTO9000
      IF(ICOM.EQ.'MARG'.AND.IHARG(1).EQ.'COLO')GOTO2900
      GOTO2999
C
 2900 CONTINUE
      CALL DPMACL(IHARG,NUMARG,IDEFMC,IMARCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2999 CONTINUE
C
C               *********************************
C               **  TREAT THE ...MAXIMUM CASE  **
C               *********************************
C
      IF(ICOM.EQ.'XMAX')GOTO3000
      IF(ICOM.EQ.'X1MA')GOTO3000
      IF(ICOM.EQ.'X2MA')GOTO3000
      IF(ICOM.EQ.'YMAX')GOTO3000
      IF(ICOM.EQ.'Y1MA')GOTO3000
      IF(ICOM.EQ.'Y2MA')GOTO3000
      IF(ICOM.EQ.'XYMA')GOTO3000
      IF(ICOM.EQ.'YXMA')GOTO3000
CCCCC IF(ICOM.EQ.'MAXI')GOTO3000
CCCCC IF(ICOM.EQ.'MAX ')GOTO3000
      IF(NUMARG.LE.0.AND.IHARG(1).EQ.'MAXI')GOTO3000
      IF(NUMARG.LE.0.AND.IHARG(1).EQ.'MAX ')GOTO3000
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAXI'.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'STAT')GOTO3000                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAXI'.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'PLOT')GOTO3000                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAX '.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'STAT')GOTO3000                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAX '.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'PLOT')GOTO3000                MARCH 1988
CCCCC THE FOLLOWING 4 LINES WERE INSERTED MARCH 1988
CCCCC THE FOLLOWING 4 LINES WERE MODIFIED JANUARY 1998
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAXI'.AND.
CCCCC1IHARG(1).NE.'STAT'.AND.IHARG(1).NE.'PLOT')GOTO3000
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MAX '.AND.
CCCCC1IHARG(1).NE.'STAT'.AND.IHARG(1).NE.'PLOT')GOTO3000
      IF(NUMARG.GE.1.AND.ICOM.EQ.'MAXI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO3099
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO3099
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO3099
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'RECO'.AND.IHARG(2).EQ.'LENG')
     1    GOTO3099
      ENDIF
C
 3000 CONTINUE
      CALL DPMAX(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MAX,GY1MAX,
     1GX2MAX,GY2MAX,
     1IX1MAX,IY1MAX,
     1IX2MAX,IY2MAX,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3099 CONTINUE
C
C               *********************************
C               **  TREAT THE ...MINIMUM CASE  **
C               *********************************
C
      IF(ICOM.EQ.'XMIN')GOTO3100
      IF(ICOM.EQ.'X1MI')GOTO3100
      IF(ICOM.EQ.'X2MI')GOTO3100
      IF(ICOM.EQ.'YMIN')GOTO3100
      IF(ICOM.EQ.'Y1MI')GOTO3100
      IF(ICOM.EQ.'Y2MI')GOTO3100
      IF(ICOM.EQ.'XYMI')GOTO3100
      IF(ICOM.EQ.'YXMI')GOTO3100
CCCCC IF(ICOM.EQ.'MINI')GOTO3100
CCCCC IF(ICOM.EQ.'MIN ')GOTO3100
      IF(NUMARG.LE.0.AND.IHARG(1).EQ.'MINI')GOTO3100
      IF(NUMARG.LE.0.AND.IHARG(1).EQ.'MIN ')GOTO3100
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MINI'.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'STAT')GOTO3100                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MINI'.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'PLOT')GOTO3100                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MIN '.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'STAT')GOTO3100                MARCH 1988
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MIN '.AND.     MARCH 1988
CCCCC1IHARG(1).NE.'PLOT')GOTO3100                MARCH 1988
CCCCC THE FOLLOWING 4 LINES WERE INSERTED MARCH 1988
CCCCC THE FOLLOWING 4 LINES WERE MODIFIED JANUARY 1998
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MINI'.AND.
CCCCC1IHARG(1).NE.'STAT'.AND.IHARG(1).NE.'PLOT')GOTO3100
CCCCC IF(NUMARG.GE.1.AND.ICOM.EQ.'MIN '.AND.
CCCCC1IHARG(1).NE.'STAT'.AND.IHARG(1).NE.'PLOT')GOTO3100
      IF(NUMARG.GE.1.AND.ICOM.EQ.'MINI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO3199
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO3199
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO3199
      ENDIF
      GOTO3199
C
 3100 CONTINUE
      CALL DPMIN(ICOM,IHARG,IARGT,ARG,NUMARG,
     1GX1MIN,GY1MIN,
     1GX2MIN,GY2MIN,
     1IX1MIN,IY1MIN,
     1IX2MIN,IY2MIN,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3199 CONTINUE
C
C               *******************************
C               **  TREAT THE PRE-SORT CASE  **
C               *******************************
C
      IF(ICOM.EQ.'PRE')GOTO3600
      GOTO3699
C
 3600 CONTINUE
      CALL DPPRES(IHARG,NUMARG,ISORSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3699 CONTINUE
C
C               *******************************************
C               **  TREAT THE ...WEIB (SCALE) AXIS CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'XWEI')GOTO3700
      IF(ICOM.EQ.'X1WE')GOTO3700
      IF(ICOM.EQ.'X2WE')GOTO3700
      IF(ICOM.EQ.'YWEI')GOTO3700
      IF(ICOM.EQ.'Y1WE')GOTO3700
      IF(ICOM.EQ.'Y2WE')GOTO3700
      IF(ICOM.EQ.'XYWE'.AND.ICOM2.EQ.'IB  ')GOTO3700
      IF(ICOM.EQ.'YXWE'.AND.ICOM2.EQ.'IB  ')GOTO3700
CCCCC IF(ICOM.EQ.'WEIB')GOTO3700
CCCCC IF(ICOM.EQ.'WEIW')GOTO3700
      GOTO3799
C
 3700 CONTINUE
      CALL DPTIS2(ICOM,IHARG,NUMARG,
     1IX1TSC,IX2TSC,IY1TSC,IY2TSC,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3799 CONTINUE
C
C               ****************************************
C               **  TREAT THE SEGMENT ... COLOR CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'SEGM')GOTO3800
      GOTO3899
C
 3800 CONTINUE
      CALL DPSECL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXSEG,ISEGCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3899 CONTINUE
C
C               ******************************************
C               **  TREAT THE SEGMENT ... PATTERN CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'SEGM')GOTO5800
      GOTO5899
C
 5800 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 (BUG WHERE DASH2, DASH3, ETC. DON'T
CCCCC GET RECOGNIZED AS DISTINCT FROM DASH)
CCCCC CALL DPSEPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
      CALL DPSEPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
     1MAXSEG,ISEGPA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5899 CONTINUE
C
C
C               ********************************************
C               **  TREAT THE SEGMENT ... THICKNESS CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'SEGM')GOTO5700
      GOTO5799
C
 5700 CONTINUE
      CALL DPSETH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXSEG,PSEGTH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5799 CONTINUE
C
C               **********************************************
C               **  TREAT THE SEGMENT ... COORDINATES CASE  **
C               **********************************************
C
      IF(ICOM.EQ.'SEGM')GOTO3900
      GOTO3999
C
 3900 CONTINUE
      CALL DPSECO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXSEG,PSEGXC,PSEGYC,NUMSEG,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3999 CONTINUE
C
C               *******************************
C               **  TREAT THE SEQUENCE CASE  **
C               *******************************
C
      IF(ICOM.EQ.'SEQU')GOTO4000
      GOTO4099
C
 4000 CONTINUE
      CALL DPSEQ(IHARG,IARGT,IARG,NUMARG,
     1ISEQSW,NUMSEQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4099 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER COLORS CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'COLO')GOTO6100
      GOTO6199
C
 6100 CONTINUE
      CALL DPCHCL(IHARG,NUMARG,IDEFCO,MAXCHA,ICHACO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6199 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER FONT   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'FONT')GOTO6110
      GOTO6119
C
 6110 CONTINUE
      CALL DPCHFO(IHARG,NUMARG,IDEFFO,MAXCHA,ICHAFO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6119 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER CASE   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'CASE')GOTO6120
      GOTO6129
C
 6120 CONTINUE
      CALL DPCHCA(IHARG,NUMARG,IDEFCA,MAXCHA,ICHACA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6129 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    DECEMBER 1994
C               ****************************************
C               **  TREAT THE CHARACTER MAPPING CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR')THEN
         IF(IHARG(1).EQ.'MAP'.OR.IHARG(1).EQ.'MAPP')THEN
            CALL DPCMAP(IHARG,NUMARG,IDCMAP,ICHMAP,IFOUND,IERROR)
            IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
         ENDIF
      ENDIF
C
C               *******************************************
C               **  TREAT THE CHARACTER THICKNESS CASE   **
C               *******************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'THIC')GOTO6130
      GOTO6139
C
 6130 CONTINUE
      CALL DPCHTH(IHARG,ARG,NUMARG,PDEFTH,MAXCHA,PCHATH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6139 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER SIZES CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'SIZE')GOTO6200
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'HEIG')GOTO6200
      GOTO6299
C
 6200 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED    JANUARY 1995
CCCCC CALL DPCHSZ(DEFSZ,MAXCHA,
      CALL DPCHSZ(PDEFHE,MAXCHA,
     1PCHAHE,PCHAWI,PCHAVG,PCHAHG,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6299 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER FILL   CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'FILL')GOTO6300
      GOTO6399
C
 6300 CONTINUE
      CALL DPCHFI(IHARG,NUMARG,IDEFFI,MAXCHA,ICHAFI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6399 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER WIDTH CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR')GOTO6400
      GOTO6499
C
 6400 CONTINUE
      CALL DPCHWI(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFWI,
     1MAXCHA,
     1PCHAWI,PCHAHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6499 CONTINUE
C
C               ***********************************************
C               **  TREAT THE CHARACTER JUSTIFICATION CASE   **
C               ***********************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'JUST'.AND.
     1IHARG2(1).EQ.'IFIC')GOTO6500
      GOTO6599
C
 6500 CONTINUE
      CALL DPCHJU(IHARG,NUMARG,MAXCHA,ICHAJU,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6599 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER OFFSET CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'OFFS'.AND.
     1IHARG2(1).EQ.'ET  ')GOTO6600
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'DISP'.AND.
     1IHARG2(1).EQ.'LACE')GOTO6600
      GOTO6699
C
 6600 CONTINUE
      CALL DPCHOF(IHARG,IARGT,IARG,ARG,NUMARG,
     1MAXCHA,
     1PCHAHO,PCHAVO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6699 CONTINUE
C
C               ****************************************
C               **  TREAT THE CHARACTER ANGLE CASE    **
C               ****************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'ANGL'.AND.
     1IHARG2(1).EQ.'E   ')GOTO6700
      GOTO6799
C
 6700 CONTINUE
      CALL DPCHAN(MAXCHA,ACHAAN,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6799 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CHARACTER HW (HEIGHT & WIDTH) CASE   **
C               *****************************************************
C
      IF(ICOM.EQ.'CHAR'.AND.IHARG(1).EQ.'HW')GOTO6800
      GOTO6899
C
 6800 CONTINUE
      CALL DPCHHW(IHARG,IARGT,IARG,ARG,NUMARG,
     1MAXCHA,
     1PCHAHE,PCHAWI,PDEFHE,PDEFWI,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6899 CONTINUE
C
C               *********************************
C               **  TREAT THE CHARACTERS CASE  **
C               *********************************
C
      IF(ICOM.EQ.'CHAR')GOTO6900
      GOTO6999
C
 6900 CONTINUE
CCCCC CALL DPCHAR(IHARG,NUMARG,MAXCHA,ICHAPA,IFOUND,IERROR)
CCCCC ARGUMENT LIST AUGMENTED FEBRUARY 1998.
CCCCC CALL DPCHAR(MAXCHA,ICHAPA,
      CALL DPCHAR(MAXCHA,ICHAPA,ICHAPO,
     1IBUGP2,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6999 CONTINUE
C
C               ****************************************
C               **  TREAT THE LEGEND ... HW     CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'LEGE')GOTO7100
      GOTO7199
C
 7100 CONTINUE
      CALL DPLEHW(IHARG,IARGT,IARG,ARG,NUMARG,
     1PDEFHE,
     1MAXLEG,
     1PLEGHE,PLEGWI,PLEGVG,PLEGHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7199 CONTINUE
C
CCCCC THE FOLLOWING ANIMATION SWITCH CHUNK WAS ADDED APRIL 1989
C               **************************************************
C               **  TREAT THE ANIMATION SWITCH CASE             **
C               **************************************************
C
      IF(ICOM.EQ.'ANIM')GOTO7200
      IF(ICOM.EQ.'UNDR')GOTO7200
      GOTO7299
C
 7200 CONTINUE
      CALL DPANIM(IHARG,NUMARG,IANISW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7299 CONTINUE
C
CCCCC THE FOLLOWING 3 DES. FOP EXP. SECTIONS WERE ADDED MAY 1989
C               ****************************************
C               **  TREAT THE DEX     WIDTH   CASE    **
C               ****************************************
C
      IF(ICOM.EQ.'DEX')GOTO8100
      GOTO8199
C
 8100 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WIDT')
     1GOTO8110
      GOTO8199
 8110 CONTINUE
      CALL DPDEWI(IHARG,ARG,NUMARG,DEFDEW,
     1DEXWID,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8199 CONTINUE
C
C               ****************************************
C               **  TREAT THE DEX     DEPTH   CASE    **
C               ****************************************
C
      IF(ICOM.EQ.'DEX')GOTO8200
      GOTO8299
C
 8200 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEPT')
     1GOTO8210
      GOTO8299
 8210 CONTINUE
      CALL DPDEDE(IHARG,IARG,NUMARG,IDEDED,
     1IDEXDE,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8299 CONTINUE
C
C               *******************************************
C               **  TREAT THE DEX HORIZONTAL AXIS   CASE **
C               *******************************************
C
      IF(ICOM.EQ.'DEX')GOTO8300
      GOTO8399
C
 8300 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'HORI'.AND.
     1IHARG(2).EQ.'AXIS')GOTO8310
      GOTO8399
 8310 CONTINUE
      CALL DPDEHA(IHARG,NUMARG,IDEFHA,
     1IDEXHA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8399 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPC.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAIPC1--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGPC,IBUGP2
 9013 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU
 9017 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9041)IMPSW,IMPNR,IMPNC,IMPCO
 9041 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9042 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IERASV
 9043 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9044 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IERASW
 9045 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9046 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)PXMIN,PXMAX,PYMIN,PYMAX
 9047 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9051)DEXWID,IDEXDE,IDEXHO
C9051 FORMAT('DEXWID,IDEXDE,IDEXHO = ',E15.7,I8,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)DEXWID,IDEXDE,IDEXHA
 9051 FORMAT('DEXWID,IDEXDE,IDEXHA = ',E15.7,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE MAIPC2(IBUGPC,IBUGP2,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
CCCCC ADD FOLLOWING LINE AUGUST 1999.
     1IMPARG,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1992
     1ITIAUT,
     1IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAIPC2.
C              (THE   PC    AT THE END OF    MAIPC2   STANDS FOR PLOT CONTROL
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES
C              PLOT CONTROL COMMANDS (PART 2).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JULY 1986.
C     UPDATED  JANUARY    1988.  (OPTIONAL OMISSION OF WORD  MAJOR)
C     UPDATED         --SEPTEMBER 1988. 3D PROJECTION (ORTHOGRAP./PERSPECT.)
C     UPDATED         --SEPTEMBER 1988. PROJECTION (ORTHOGRAPHIC/PERSPECTIVE)
C                       MOVED TO MAIPC4 FOR GENERAL 3-D.
C     UPDATED         --SEPTEMBER 1988.  VISIBLE
C                       MOVED TO MAIPC4 FOR GENERAL 3-D.
C     UPDATED         --DECEMBER 1988.  TIC/TIC LABEL/TITLE SIZE DEFAULT WIDTH
C     UPDATED         --FEBRUARY 1989.  ADDED MANY ATTRIBUTE COMMANDS (ALAN)
C     UPDATED         --JULY     1989.  TITLE DISPLACEMENT
C     UPDATED         --MAY      1990.  TIC MARK OFFSET
C     UPDATED         --AUGUST   1990.  MP FOR MULTIPLOT
C     UPDATED         --AUGUST   1990.  WINDOW SYSTEM
C     UPDATED         --AUGUST   1990.  WINDOW POINTER
C     UPDATED         --AUGUST   1990.  WINDOW SYSTEM COMMON
C     UPDATED         --AUGUST   1991.  TIC LABEL DISPLACEMENT
C     UPDATED         --APRIL    1992.  GRID PATTERN CODE REDUNDANT
C     UPDATED         --AUGUST   1992.  ADD TITLE SWITCH FOR AUTOMATIC
C     UPDATED         --DECEMBER 1992.  FIX CALL TO DPTLDS
C     UPDATED         --SEPTEMBER 1993. LOWER CASE--TIC LABEL CONTENTS
C     UPDATED         --SEPTEMBER 1993. LOWER CASE FOR TITLE
C     UPDATED         --SEPTEMBER 1993. CHAR*4 FOR ITIAUT
C     UPDATED         --AUGUST    1995. DASH2 BUG (VARIOUS)
C     UPDATED         --APRIL     1997. PIXMAP TITLE COMMAND
C     UPDATED         --SEPTEMBER 1998. CALL TO DPMULT
C     UPDATED         --AUGUST    1999. CALL TO DPMULT
C     UPDATED         --NOVEMBER  1999. SUBREGION SWITCH
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGPC
      CHARACTER*4 IBUGP2
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
C
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1993
      CHARACTER*4 ITIAUT
CCCCC OCTOBER 1996
      CHARACTER*4 IWINPO
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING WINDOW SYSTEM COMMON WAS ADDED AUGUST 1990
      INCLUDE 'DPCOWI.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGPC.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAIPC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGPC,IBUGP2
   53 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,60)INEGAT,IFOUND,IERROR
CCC60 FORMAT('INEGSW,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,81)IMPSW,IMPNR,IMPNC,IMPCO
   81 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   82 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IERASV
   83 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   84 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IERASW
   85 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   86 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)PXMIN,PXMAX,PYMIN,PYMAX
   87 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
C
C
C               **************************************
C               **  TREAT THE ...TIC PATTERN CASE   **
C               **************************************
C NOTE: THIS CASE NOT STORED IN COMMON BLOCKS (INCLUDE FILE "DPCOPC")
C       OR IMPLEMENTED IN CODE
C
C
CCCCC IF(ICOM.EQ.'XTIC')GOTO4220
CCCCC IF(ICOM.EQ.'X1TI')GOTO4220
CCCCC IF(ICOM.EQ.'X2TI')GOTO4220
CCCCC IF(ICOM.EQ.'YTIC')GOTO4220
CCCCC IF(ICOM.EQ.'Y1TI')GOTO4220
CCCCC IF(ICOM.EQ.'Y2TI')GOTO4220
CCCCC IF(ICOM.EQ.'TIC')GOTO4220
CCCCC IF(ICOM.EQ.'TICS')GOTO4220
CCCCC IF(ICOM.EQ.'XYTI')GOTO4220
CCCCC IF(ICOM.EQ.'YXTI')GOTO4220
CCCCC GOTO4229
C
C4220 CONTINUE
CCCCC CALL DPTCPA(ICOM,IHARG,NUMARG,
CCCCC1IDEFPA,
CCCCC1IX1TPA,IX2TPA,IY1TPA,IY2TPA,
CCCCC1IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C4229 CONTINUE
C
C               ****************************************
C               **  TREAT THE ...TIC THICKNESS CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4230
      IF(ICOM.EQ.'X1TI')GOTO4230
      IF(ICOM.EQ.'X2TI')GOTO4230
      IF(ICOM.EQ.'YTIC')GOTO4230
      IF(ICOM.EQ.'Y1TI')GOTO4230
      IF(ICOM.EQ.'Y2TI')GOTO4230
      IF(ICOM.EQ.'TIC')GOTO4230
      IF(ICOM.EQ.'TICS')GOTO4230
      IF(ICOM.EQ.'XYTI')GOTO4230
      IF(ICOM.EQ.'YXTI')GOTO4230
      GOTO4239
C
 4230 CONTINUE
      CALL DPTCTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PTICTH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4239 CONTINUE
C               *****************************
C               **  TREAT THE ...TIC  CASE **
C               *****************************
C
      IF(ICOM.EQ.'XTIC')GOTO4100
      IF(ICOM.EQ.'X1TI')GOTO4100
      IF(ICOM.EQ.'X2TI')GOTO4100
      IF(ICOM.EQ.'YTIC')GOTO4100
      IF(ICOM.EQ.'Y1TI')GOTO4100
      IF(ICOM.EQ.'Y2TI')GOTO4100
      IF(ICOM.EQ.'TIC ')GOTO4100
      IF(ICOM.EQ.'TICS')GOTO4100
      IF(ICOM.EQ.'XYTI')GOTO4100
      IF(ICOM.EQ.'YXTI')GOTO4100
      GOTO4199
C
 4100 CONTINUE
      CALL DPTIC(ICOM,IHARG,NUMARG,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4199 CONTINUE
C
C               ************************************
C               **  TREAT THE ...TIC COLOR CASE   **
C               ************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4200
      IF(ICOM.EQ.'X1TI')GOTO4200
      IF(ICOM.EQ.'X2TI')GOTO4200
      IF(ICOM.EQ.'YTIC')GOTO4200
      IF(ICOM.EQ.'Y1TI')GOTO4200
      IF(ICOM.EQ.'Y2TI')GOTO4200
      IF(ICOM.EQ.'TIC')GOTO4200
      IF(ICOM.EQ.'TICS')GOTO4200
      IF(ICOM.EQ.'XYTI')GOTO4200
      IF(ICOM.EQ.'YXTI')GOTO4200
      GOTO4299
C
 4200 CONTINUE
      CALL DPTCCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1TCO,IX2TCO,IY1TCO,IY2TCO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4299 CONTINUE
C
C               ************************************
C               **  TREAT THE ...TIC DECIMALS CASE**
C               ************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4300
      IF(ICOM.EQ.'X1TI')GOTO4300
      IF(ICOM.EQ.'X2TI')GOTO4300
      IF(ICOM.EQ.'YTIC')GOTO4300
      IF(ICOM.EQ.'Y1TI')GOTO4300
      IF(ICOM.EQ.'Y2TI')GOTO4300
      IF(ICOM.EQ.'TIC')GOTO4300
      IF(ICOM.EQ.'TICS')GOTO4300
      IF(ICOM.EQ.'XYTI')GOTO4300
      IF(ICOM.EQ.'YXTI')GOTO4300
      GOTO4399
C
 4300 CONTINUE
      CALL DPTCDP(ICOM,IHARG,IARGT,IARG,NUMARG,
     1IDEFDP,
     1IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4399 CONTINUE
C
C               ***************************************
C               **  TREAT THE ...TIC POSITION CASE   **
C               ***************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4400
      IF(ICOM.EQ.'X1TI')GOTO4400
      IF(ICOM.EQ.'X2TI')GOTO4400
      IF(ICOM.EQ.'YTIC')GOTO4400
      IF(ICOM.EQ.'Y1TI')GOTO4400
      IF(ICOM.EQ.'Y2TI')GOTO4400
      IF(ICOM.EQ.'TIC')GOTO4400
      IF(ICOM.EQ.'TICS')GOTO4400
      IF(ICOM.EQ.'XYTI')GOTO4400
      IF(ICOM.EQ.'YXTI')GOTO4400
      GOTO4499
C
 4400 CONTINUE
      CALL DPTCJU(ICOM,IHARG,NUMARG,
     1IX1TJU,IX2TJU,IY1TJU,IY2TJU,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4499 CONTINUE
C
C               *************************************
C               **  TREAT THE ...TIC SIZE CASE     **
C               *************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4500
      IF(ICOM.EQ.'X1TI')GOTO4500
      IF(ICOM.EQ.'X2TI')GOTO4500
      IF(ICOM.EQ.'YTIC')GOTO4500
      IF(ICOM.EQ.'Y1TI')GOTO4500
      IF(ICOM.EQ.'Y2TI')GOTO4500
      IF(ICOM.EQ.'TIC')GOTO4500
      IF(ICOM.EQ.'TICS')GOTO4500
      IF(ICOM.EQ.'XYTI')GOTO4500
      IF(ICOM.EQ.'YXTI')GOTO4500
      GOTO4599
C
 4500 CONTINUE
      CALL DPTCSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1DEFTL,
     1PX1TLE,PX2TLE,PY1TLE,PY2TLE,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4599 CONTINUE
C
C               *************************************
C               **  TREAT THE ...TIC OFFSET CASE   **
C               *************************************
C
      IF(ICOM.EQ.'XTIC')GOTO9400
      IF(ICOM.EQ.'X1TI')GOTO9400
      IF(ICOM.EQ.'X2TI')GOTO9400
      IF(ICOM.EQ.'YTIC')GOTO9400
      IF(ICOM.EQ.'Y1TI')GOTO9400
      IF(ICOM.EQ.'Y2TI')GOTO9400
      IF(ICOM.EQ.'TIC')GOTO9400
      IF(ICOM.EQ.'TICS')GOTO9400
      IF(ICOM.EQ.'XYTI')GOTO9400
      IF(ICOM.EQ.'YXTI')GOTO9400
      GOTO9499
C
 9400 CONTINUE
      CALL DPTCOF(ICOM,IHARG,IARGT,ARG,NUMARG,
     1DEFTOF,IDEFTU,
     1ITICUN,
     1PX1TOL,PX2TOL,PY1TOB,PY2TOB,
     1PX1TOR,PX2TOR,PY1TOT,PY2TOT,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 9499 CONTINUE
C
C
C               *************************************************
C               **  TREAT THE ...TIC LABEL DISPLACEMENT  CASE  **
C               *************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4700
      IF(ICOM.EQ.'X1TI')GOTO4700
      IF(ICOM.EQ.'X2TI')GOTO4700
      IF(ICOM.EQ.'YTIC')GOTO4700
      IF(ICOM.EQ.'Y1TI')GOTO4700
      IF(ICOM.EQ.'Y2TI')GOTO4700
      IF(ICOM.EQ.'TIC')GOTO4700
      IF(ICOM.EQ.'TICS')GOTO4700
      IF(ICOM.EQ.'XYTI')GOTO4700
      IF(ICOM.EQ.'YXTI')GOTO4700
      GOTO4709
C
CCCCC DECEMBER 1992.  FIX BUG.  PDEFHG AND PDEFVG ARE THE DEFAULT
CCCCC HORIZONTAL AND VERTICAL GAPS, NOT THE DEFAULT DISPLACEMENT.
 4700 CONTINUE
CCCCC FOLLOWING LINE ADDED DECEMBER 1992.  (DEFAULT VERTICAL DISPLACEMENT
CCCCC DISPLACEMENT IS 0.5 GREATER THAN DEFAULT HORIZONTAL.
      PJUNK=PDEFDS-0.5
      CALL DPTLDS(ICOM,IHARG,IARGT,ARG,NUMARG,
CCCCC FOLLOWING LINE MODIFIED DECEMBER 1992.
CCCCC1PDEFHG,PDEFVG,
     1PDEFDS,PJUNK,
     1PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4709 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL FONT  CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4710
      IF(ICOM.EQ.'X1TI')GOTO4710
      IF(ICOM.EQ.'X2TI')GOTO4710
      IF(ICOM.EQ.'YTIC')GOTO4710
      IF(ICOM.EQ.'Y1TI')GOTO4710
      IF(ICOM.EQ.'Y2TI')GOTO4710
      IF(ICOM.EQ.'TIC')GOTO4710
      IF(ICOM.EQ.'TICS')GOTO4710
      IF(ICOM.EQ.'XYTI')GOTO4710
      IF(ICOM.EQ.'YXTI')GOTO4710
      GOTO4719
C
 4710 CONTINUE
      CALL DPTLFO(ICOM,IHARG,NUMARG,
     1IDEFFO,
     1IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4719 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL CASE  CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4720
      IF(ICOM.EQ.'X1TI')GOTO4720
      IF(ICOM.EQ.'X2TI')GOTO4720
      IF(ICOM.EQ.'YTIC')GOTO4720
      IF(ICOM.EQ.'Y1TI')GOTO4720
      IF(ICOM.EQ.'Y2TI')GOTO4720
      IF(ICOM.EQ.'TIC')GOTO4720
      IF(ICOM.EQ.'TICS')GOTO4720
      IF(ICOM.EQ.'XYTI')GOTO4720
      IF(ICOM.EQ.'YXTI')GOTO4720
      GOTO4729
C
 4720 CONTINUE
      CALL DPTLCA(ICOM,IHARG,NUMARG,
     1IDEFCA,
     1IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4729 CONTINUE
C
C               *************************************************
C               **  TREAT THE ...TIC LABEL JUSTIFICATION CASE  **
C               *************************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4730
      IF(ICOM.EQ.'X1TI')GOTO4730
      IF(ICOM.EQ.'X2TI')GOTO4730
      IF(ICOM.EQ.'YTIC')GOTO4730
      IF(ICOM.EQ.'Y1TI')GOTO4730
      IF(ICOM.EQ.'Y2TI')GOTO4730
      IF(ICOM.EQ.'TIC')GOTO4730
      IF(ICOM.EQ.'TICS')GOTO4730
      IF(ICOM.EQ.'XYTI')GOTO4730
      IF(ICOM.EQ.'YXTI')GOTO4730
      GOTO4739
C
 4730 CONTINUE
      CALL DPTLJU(ICOM,IHARG,NUMARG,
     1IDEFJU,
     1IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4739 CONTINUE
C
C               *********************************************
C               **  TREAT THE ...TIC LABEL DIRECTION CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4740
      IF(ICOM.EQ.'X1TI')GOTO4740
      IF(ICOM.EQ.'X2TI')GOTO4740
      IF(ICOM.EQ.'YTIC')GOTO4740
      IF(ICOM.EQ.'Y1TI')GOTO4740
      IF(ICOM.EQ.'Y2TI')GOTO4740
      IF(ICOM.EQ.'TIC')GOTO4740
      IF(ICOM.EQ.'TICS')GOTO4740
      IF(ICOM.EQ.'XYTI')GOTO4740
      IF(ICOM.EQ.'YXTI')GOTO4740
      GOTO4749
C
 4740 CONTINUE
      CALL DPTLDI(ICOM,IHARG,NUMARG,
     1IDEFDI,
     1IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4749 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL FILL  CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4750
      IF(ICOM.EQ.'X1TI')GOTO4750
      IF(ICOM.EQ.'X2TI')GOTO4750
      IF(ICOM.EQ.'YTIC')GOTO4750
      IF(ICOM.EQ.'Y1TI')GOTO4750
      IF(ICOM.EQ.'Y2TI')GOTO4750
      IF(ICOM.EQ.'TIC')GOTO4750
      IF(ICOM.EQ.'TICS')GOTO4750
      IF(ICOM.EQ.'XYTI')GOTO4750
      IF(ICOM.EQ.'YXTI')GOTO4750
      GOTO4759
C
 4750 CONTINUE
      CALL DPTLFI(ICOM,IHARG,NUMARG,
     1IDEFFI,
     1IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4759 CONTINUE
C
C               *********************************************
C               **  TREAT THE ...TIC LABEL THICKNESS CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4760
      IF(ICOM.EQ.'X1TI')GOTO4760
      IF(ICOM.EQ.'X2TI')GOTO4760
      IF(ICOM.EQ.'YTIC')GOTO4760
      IF(ICOM.EQ.'Y1TI')GOTO4760
      IF(ICOM.EQ.'Y2TI')GOTO4760
      IF(ICOM.EQ.'TIC')GOTO4760
      IF(ICOM.EQ.'TICS')GOTO4760
      IF(ICOM.EQ.'XYTI')GOTO4760
      IF(ICOM.EQ.'YXTI')GOTO4760
      GOTO4769
C
 4760 CONTINUE
      CALL DPTLTH(ICOM,IHARG,ARG,NUMARG,
     1PDEFTH,
     1PTIZTH,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4769 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL ANGLE CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4770
      IF(ICOM.EQ.'X1TI')GOTO4770
      IF(ICOM.EQ.'X2TI')GOTO4770
      IF(ICOM.EQ.'YTIC')GOTO4770
      IF(ICOM.EQ.'Y1TI')GOTO4770
      IF(ICOM.EQ.'Y2TI')GOTO4770
      IF(ICOM.EQ.'TIC')GOTO4770
      IF(ICOM.EQ.'TICS')GOTO4770
      IF(ICOM.EQ.'XYTI')GOTO4770
      IF(ICOM.EQ.'YXTI')GOTO4770
      GOTO4779
C
 4770 CONTINUE
      CALL DPTLAN(ICOM,IHARG,ARG,NUMARG,
     1ADEFAN,
     1AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4779 CONTINUE
C               *************************************
C               **  TREAT THE ...TIC LABEL  CASE   **
C               *************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4780
      IF(ICOM.EQ.'X1TI')GOTO4780
      IF(ICOM.EQ.'X2TI')GOTO4780
      IF(ICOM.EQ.'YTIC')GOTO4780
      IF(ICOM.EQ.'Y1TI')GOTO4780
      IF(ICOM.EQ.'Y2TI')GOTO4780
      IF(ICOM.EQ.'TIC')GOTO4780
      IF(ICOM.EQ.'TICS')GOTO4780
      IF(ICOM.EQ.'XYTI')GOTO4780
      IF(ICOM.EQ.'YXTI')GOTO4780
      GOTO4789
C
 4780 CONTINUE
      CALL DPTL(ICOM,IHARG,NUMARG,
     1IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4789 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL COLOR CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4790
      IF(ICOM.EQ.'X1TI')GOTO4790
      IF(ICOM.EQ.'X2TI')GOTO4790
      IF(ICOM.EQ.'YTIC')GOTO4790
      IF(ICOM.EQ.'Y1TI')GOTO4790
      IF(ICOM.EQ.'Y2TI')GOTO4790
      IF(ICOM.EQ.'TIC')GOTO4790
      IF(ICOM.EQ.'TICS')GOTO4790
      IF(ICOM.EQ.'XYTI')GOTO4790
      IF(ICOM.EQ.'YXTI')GOTO4790
      GOTO4799
C
 4790 CONTINUE
      CALL DPTLCL(ICOM,IHARG,NUMARG,
     1IDEFCO,
     1IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4799 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL SIZE  CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4800
      IF(ICOM.EQ.'X1TI')GOTO4800
      IF(ICOM.EQ.'X2TI')GOTO4800
      IF(ICOM.EQ.'YTIC')GOTO4800
      IF(ICOM.EQ.'Y1TI')GOTO4800
      IF(ICOM.EQ.'Y2TI')GOTO4800
      IF(ICOM.EQ.'TIC')GOTO4800
      IF(ICOM.EQ.'TICS')GOTO4800
      IF(ICOM.EQ.'XYTI')GOTO4800
      IF(ICOM.EQ.'YXTI')GOTO4800
      GOTO4809
C
 4800 CONTINUE
      CALL DPTLSZ(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4809 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL FORMAT CASE **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4810
      IF(ICOM.EQ.'X1TI')GOTO4810
      IF(ICOM.EQ.'X2TI')GOTO4810
      IF(ICOM.EQ.'YTIC')GOTO4810
      IF(ICOM.EQ.'Y1TI')GOTO4810
      IF(ICOM.EQ.'Y2TI')GOTO4810
      IF(ICOM.EQ.'TIC')GOTO4810
      IF(ICOM.EQ.'TICS')GOTO4810
      IF(ICOM.EQ.'XYTI')GOTO4810
      IF(ICOM.EQ.'YXTI')GOTO4810
      GOTO4819
C
 4810 CONTINUE
      CALL DPTLFM(ICOM,IHARG,NUMARG,
     1IDETLF,
     1IX1ZFM,IX2ZFM,IY1ZFM,IY2ZFM,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4819 CONTINUE
C
C               *******************************************
C               **  TREAT THE ...TIC LABEL CONTENTS CASE **
C               *******************************************
C
      IF(ICOM.EQ.'XTIC')GOTO4820
      IF(ICOM.EQ.'X1TI')GOTO4820
      IF(ICOM.EQ.'X2TI')GOTO4820
      IF(ICOM.EQ.'YTIC')GOTO4820
      IF(ICOM.EQ.'Y1TI')GOTO4820
      IF(ICOM.EQ.'Y2TI')GOTO4820
      IF(ICOM.EQ.'TIC')GOTO4820
      IF(ICOM.EQ.'TICS')GOTO4820
      IF(ICOM.EQ.'XYTI')GOTO4820
      IF(ICOM.EQ.'YXTI')GOTO4820
      GOTO4829
C
 4820 CONTINUE
      CALL DPTLCN(ICOM,IHARG,NUMARG,
CCCCC THE FOLLOWING LINE WAS AUGMENTED       SEPTEMBER 1993
CCCCC SO AS TO ALLOW LOWER CASE              SEPTEMBER 1993
CCCCC1IANS,IWIDTH,
     1IANS,IANSLC,IWIDTH,
     1IX1ZCN,IX2ZCN,IY1ZCN,IY2ZCN,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4829 CONTINUE
C
C               **********************************
C               **  TREAT THE TITLE FONT  CASE  **
C               **********************************
C
      IF(ICOM.EQ.'TITL')GOTO5010
      GOTO5019
C
 5010 CONTINUE
      CALL DPTIFO(IHARG,NUMARG,IDEFFO,ITITFO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5019 CONTINUE
C
C               **********************************
C               **  TREAT THE TITLE CASE  CASE  **
C               **********************************
C
      IF(ICOM.EQ.'TITL')GOTO5020
      GOTO5029
C
 5020 CONTINUE
      CALL DPTICA(IHARG,NUMARG,IDEFCA,ITITCA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5029 CONTINUE
C
C               **************************************
C               **  TREAT THE TITLE THICKNESS CASE  **
C               **************************************
C
      IF(ICOM.EQ.'TITL')GOTO5030
      GOTO5039
C
 5030 CONTINUE
      CALL DPTITH(IHARG,ARG,NUMARG,PDEFTH,PTITTH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5039 CONTINUE
C
C
CCCCC THE FOLLOWING SECTION WAS ADDED JULY 1989
C               **************************************
C               **  TREAT THE TITLE DISPLACEMENT CASE  **
C               **************************************
C
      IF(ICOM.EQ.'TITL')GOTO5040
      GOTO5049
C
 5040 CONTINUE
      CALL DPTIDS(IHARG,ARG,NUMARG,PDEFDS,PTITDS,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5049 CONTINUE
C
C               ****************************
C               **  TREAT THE TITLE CASE  **
C               ****************************
C
      IF(ICOM.EQ.'TITL')GOTO4900
      GOTO4999
C
 4900 CONTINUE
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
CCCCC CALL DPTIT(IANS,IWIDTH,IHARG,NUMARG,
CCCCC THE FOLLOWING LINE WAS AUGMENTED       SEPTEMBER 1993
CCCCC SO AS TO ALLOW LOWER CASE              SEPTEMBER 1993
CCCCC CALL DPTIT(IANS,IWIDTH,IHARG,IHARG2,NUMARG,
      CALL DPTIT(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1992
CCCCC1ITITTE,NCTITL,IBUGP2,IFOUND,IERROR)
     1ITITTE,NCTITL,ITIAUT,IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4999 CONTINUE
C
C               **********************************
C               **  TREAT THE TITLE COLOR CASE  **
C               **********************************
C
      IF(ICOM.EQ.'TITL')GOTO5000
      GOTO5099
C
 5000 CONTINUE
      CALL DPTICL(IHARG,NUMARG,IDEFCO,ITITCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5099 CONTINUE
C
C               **********************************
C               **  TREAT THE TITLE SIZE  CASE  **
C               **********************************
C
      IF(ICOM.EQ.'TITL')GOTO5100
      GOTO5199
C
 5100 CONTINUE
      CALL DPTISZ(IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PTITHE,PTITWI,PTITVG,PTITHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5199 CONTINUE
C
C               *****************************
C               **  TREAT THE NEGATE CASE  **
C               *****************************
C
      IF(ICOM.EQ.'NEGA')GOTO5300
      GOTO5399
C
 5300 CONTINUE
      CALL DPNEGA(IHARG,NUMARG,INEGSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5399 CONTINUE
C
C               *************************************************
C               **  TREAT THE WINDOW (CORNER) COORDINATES CASE **
C               *************************************************
C
      IF(ICOM.EQ.'WIND')GOTO5400
      GOTO5499
C
 5400 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CORN'.AND.
     1IHARG(2).EQ.'COOR')GOTO5411
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')
     1GOTO5430
      GOTO5499
 5411 CONTINUE
      ISHIFT=1
      GOTO5420
 5420 CONTINUE
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      GOTO5430
 5430 CONTINUE
      CALL DPWICC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5499 CONTINUE
C
C               *********************************
C               **  TREAT THE HORIZONTAL CASE  **
C               *********************************
C
      IF(ICOM.EQ.'HORI'.AND.IHARG(1).EQ.'SWIT')GOTO5500
      GOTO5599
C
 5500 CONTINUE
      CALL DPHRIZ(IHARG,NUMARG,IHORSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5599 CONTINUE
C
C               **********************************************
C               **  TREAT THE MAJOR TIC MARK NUMBER   CASE  **
C               **********************************************
C
      IF(ICOM.EQ.'MAJO')GOTO5800
C  FEBRUARY, 1988: CHECK FOR "MINOR TIC MARK NUMBER"
      IF(ICOM.EQ.'MINO')GOTO5899
C  END CHANGE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'NUMB')GOTO5800
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'NUMB')GOTO5800
      IF(NUMARG.GE.3.AND.IHARG(3).EQ.'NUMB')GOTO5800
      IF(NUMARG.GE.4.AND.IHARG(4).EQ.'NUMB')GOTO5800
      GOTO5899
C
 5800 CONTINUE
      CALL DPMATN(ICOM,IHARG,IARGT,IARG,NUMARG,
     1IX1JSW,IX2JSW,IY1JSW,IY2JSW,
     1NMJX1T,NMJX2T,NMJY1T,NMJY2T,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
 
 5899 CONTINUE
C
C               **********************************************
C               **  TREAT THE MINOR TIC MARK NUMBER   CASE  **
C               **********************************************
C
      IF(ICOM.EQ.'MINO')GOTO5900
      GOTO5999
C
 5900 CONTINUE
      CALL DPMITN(IHARG,IARGT,IARG,NUMARG,
     1IX1NSW,IX2NSW,IY1NSW,IY2NSW,
     1NMNX1T,NMNX2T,NMNY1T,NMNY2T,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5999 CONTINUE
C
C               *****************************************
C               **  TREAT THE ...TIC LABEL HW    CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'XTIC')GOTO6000
      IF(ICOM.EQ.'X1TI')GOTO6000
      IF(ICOM.EQ.'X2TI')GOTO6000
      IF(ICOM.EQ.'YTIC')GOTO6000
      IF(ICOM.EQ.'Y1TI')GOTO6000
      IF(ICOM.EQ.'Y2TI')GOTO6000
      IF(ICOM.EQ.'TIC')GOTO6000
      IF(ICOM.EQ.'TICS')GOTO6000
      IF(ICOM.EQ.'XYTI')GOTO6000
      IF(ICOM.EQ.'YXTI')GOTO6000
      GOTO6099
C
 6000 CONTINUE
      CALL DPTLHW(ICOM,IHARG,IARGT,ARG,NUMARG,
     1PDEFHE,PDEFWI,
     1PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG,
     1PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG,
     1PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG,
     1PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6099 CONTINUE
C
C               *****************************************
C               **  TREAT THE MAJOR TIC COORDINATES CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'MAJO')GOTO6100
      GOTO6199
C
 6100 CONTINUE
      CALL DPMJTC(ICOM,IHARG,IARGT,ARG,NUMARG,
     1IX1TSW,IX2TSW,IY1TSW,IY2TSW,
     1X1COOR,X2COOR,Y1COOR,Y2COOR,
     1NX1COO,NX2COO,NY1COO,NY2COO,
     1MAXTIC,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6199 CONTINUE
C
C               *****************************************
C               **  TREAT THE MINOR TIC COORDINATES CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'MINO')GOTO6200
      GOTO6299
C
 6200 CONTINUE
      CALL DPMNTC(ICOM,IHARG,IARGT,ARG,NUMARG,
     1X1COMN,X2COMN,Y1COMN,Y2COMN,
     1NX1CMN,NX2CMN,NY1CMN,NY2CMN,
     1MAXTIC,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6299 CONTINUE
C
CCCCC THE FOLLOWING CODE WAS COMMENTED OUT AS REDUNDANT   APRIL 1992 (ALAN)
C               **********************************
C               **  TREAT THE GRID  PATTERN CASE  **
C               **********************************
C
CCCCC IF(ICOM.EQ.'XGRI')GOTO6300
CCCCC IF(ICOM.EQ.'YGRI')GOTO6300
CCCCC IF(ICOM.EQ.'XYGR')GOTO6300
CCCCC IF(ICOM.EQ.'YXGR')GOTO6300
CCCCC IF(ICOM.EQ.'GRID')GOTO6300
CCCCC GOTO6399
C
C6300 CONTINUE
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO6310
CCCCC GOTO6399
C6310 CONTINUE
CCCCC CALL DPGRPA(ICOM,IHARG,NUMARG,
CCCCC1IDEFPA,
CCCCC1IVGRPA,IHGRPA,
CCCCC1IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6399 CONTINUE
C
C               ***********************************
C               **  TREAT THE FILL  COLORS CASE  **
C               ***********************************
C
CCCCC IF(ICOM.EQ.'FILL'.AND.IHARG(1).EQ.'COLO')GOTO6500
CCCCC GOTO6599
C
C6500 CONTINUE
CCCCC CALL DPFICO(IHARG,NUMARG,IDEFFC,MAXFIL,IFILCO,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6599 CONTINUE
C
C               ***********************************
C               **  TREAT THE FILL SPACING CASE  **
C               ***********************************
C
CCCCC IF(ICOM.EQ.'FILL'.AND.IHARG(1).EQ.'SPAC')GOTO6600
CCCCC GOTO6699
C
C6600 CONTINUE
CCCCC CALL DPFISP(IHARG,IARGT,ARG,NUMARG,PDPFFG,MAXFIL,PFILSP,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6699 CONTINUE
C
C               *************************************
C               **  TREAT THE FILL THICKNESS CASE  **
C               *************************************
C
CCCCC IF(ICOM.EQ.'FILL'.AND.IHARG(1).EQ.'THIC')GOTO6700
CCCCC GOTO6799
C
C6700 CONTINUE
CCCCC CALL DPFITH(IHARG,IARGT,ARG,NUMARG,PDEFFT,MAXFIL,PFILTH,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6799 CONTINUE
C
C               ********************************
C               **  TREAT THE FILL  BASE CASE **
C               ********************************
C
CCCCC IF(ICOM.EQ.'FILL'.AND.IHARG(1).EQ.'BASE')GOTO6800
CCCCC IF(ICOM.EQ.'FILL'.AND.IHARG(1).EQ.'REFE')GOTO6800
CCCCC1 GOTO6899
C
C6800 CONTINUE
CCCCC CALL DPFIBA(IHARG,IARGT,ARG,NUMARG,ADEFFB,MAXFIL,AFILBA,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6899 CONTINUE
C
C               ***********************************
C               **  TREAT THE FILL (SWITCH) CASE **
C               ***********************************
C
CCCCC IF(ICOM.EQ.'FILL')GOTO6900
CCCCC GOTO6999
C
C6900 CONTINUE
CCCCC IF(IHARG(1).EQ.'ON')GOTO6910
CCCCC IF(IHARG(2).EQ.'ON')GOTO6910
CCCCC IF(IHARG(1).EQ.'OFF')GOTO6910
CCCCC IF(IHARG(2).EQ.'OFF')GOTO6910
CCCCC GOTO6999
C6910 CONTINUE
CCCCC CALL DPFISW(IHARG,NUMARG,IDEFFS,MAXFIL,IFILSW,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C6999 CONTINUE
C
C               *************************************
C               **  TREAT THE FILL (PATTERN) CASE  **
C               *************************************
C
CCCCC IF(ICOM.EQ.'FILL')GOTO7000
CCCCC GOTO7099
C
C7000 CONTINUE
CCCCC CALL DPFIPA(IHARG,NUMARG,IDEFFP,MAXFIL,IFILPA,
CCCCC1IBUGP2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C7099 CONTINUE
C
C               *************************************
C               **  TREAT THE PATTERN LINE   CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'LINE')GOTO7100
      GOTO7199
C
 7100 CONTINUE
      CALL DPPALI(IHARG,NUMARG,IDEFPL,MAXPAT,IPATLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7199 CONTINUE
C
C               **************************************
C               **  TREAT THE PATTERN SPACING CASE  **
C               **************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'SPAC')GOTO7200
      GOTO7299
C
 7200 CONTINUE
      CALL DPPASP(IHARG,IARGT,ARG,NUMARG,PDEFPG,MAXPAT,PPATSP,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7299 CONTINUE
C
C               ****************************************
C               **  TREAT THE PATTERN THICKNESS CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'THIC')GOTO7300
      GOTO7399
C
 7300 CONTINUE
      CALL DPPATH(IHARG,IARGT,ARG,NUMARG,PDEFPT,MAXPAT,PPATTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7399 CONTINUE
C
C               ****************************************
C               **  TREAT THE PATTERN HEIGHT    CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'HEIG')GOTO7400
      GOTO7499
C
 7400 CONTINUE
      CALL DPPAHE(IHARG,IARGT,ARG,NUMARG,PDEFPH,MAXPAT,PPATHE,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7499 CONTINUE
C
C               ****************************************
C               **  TREAT THE PATTERN WIDTH     CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'WIDT')GOTO7500
      GOTO7599
C
 7500 CONTINUE
      CALL DPPAWI(IHARG,IARGT,ARG,NUMARG,PDEFPW,MAXPAT,PPATWI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7599 CONTINUE
C
C               *************************************
C               **  TREAT THE PATTERN COLOR  CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PATT'.AND.IHARG(1).EQ.'COLO')GOTO7600
      GOTO7699
C
 7600 CONTINUE
      CALL DPPACO(IHARG,NUMARG,IDEFPC,MAXPAT,IPATCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7699 CONTINUE
C
C               **************************************
C               **  TREAT THE PATTERN (SWITCH) CASE **
C               **************************************
C
      IF(ICOM.EQ.'PATT')GOTO7700
      GOTO7799
C
 7700 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO7710
      IF(IHARG(2).EQ.'ON')GOTO7710
      IF(IHARG(1).EQ.'OFF')GOTO7710
      IF(IHARG(2).EQ.'OFF')GOTO7710
      GOTO7799
 7710 CONTINUE
      CALL DPPASW(IHARG,NUMARG,IDEFPS,MAXPAT,IPATSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7799 CONTINUE
C
C               ****************************************
C               **  TREAT THE PATTERN (PATTERN) CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'PATT')GOTO7800
      GOTO7899
C
 7800 CONTINUE
      CALL DPPAPA(IHARG,NUMARG,IDEFPP,MAXPAT,IPATPA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7899 CONTINUE
C
C               ***********************************
C               **  TREAT THE SPIKE COLORS CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'COLO')GOTO8100
      GOTO8199
C
 8100 CONTINUE
      CALL DPSPCO(IHARG,NUMARG,IDEFSC,MAXSPI,ISPICO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8199 CONTINUE
C
C               *************************************
C               **  TREAT THE SPIKE THICKNESS CASE **
C               *************************************
C
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'THIC')GOTO8200
      GOTO8299
C
 8200 CONTINUE
      CALL DPSPTH(IHARG,IARGT,ARG,NUMARG,PDEFST,MAXSPI,PSPITH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8299 CONTINUE
C
C               *************************************
C               **  TREAT THE SPIKE LINE      CASE **
C               *************************************
C
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'LINE')GOTO8300
      GOTO8399
C
 8300 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPSPLI(IHARG,NUMARG,IDEFSL,MAXSPI,ISPILI,
      CALL DPSPLI(IHARG,IHARG2,NUMARG,IDEFSL,MAXSPI,ISPILI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8399 CONTINUE
C
C               ********************************
C               **  TREAT THE SPIKE BASE CASE **
C               ********************************
C
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'BASE')GOTO8400
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'REFE')GOTO8400
      GOTO8499
C
 8400 CONTINUE
      CALL DPSPBA(IHARG,IARGT,ARG,NUMARG,ADEFSB,MAXSPI,ASPIBA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8499 CONTINUE
C
C               **************************************
C               **  TREAT THE SPIKE DIRECTION CASE  **
C               **************************************
C
      IF(ICOM.EQ.'SPIK'.AND.IHARG(1).EQ.'DIRE')GOTO8500
      GOTO8599
C
 8500 CONTINUE
      CALL DPSPDI(IHARG,NUMARG,IDEFSD,MAXSPI,ISPIDI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8599 CONTINUE
C
C               ***********************************
C               **  TREAT THE SPIKE (SWITCH) CASE**
C               ***********************************
C
      IF(ICOM.EQ.'SPIK')GOTO8600
      GOTO8699
C
 8600 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO8610
      IF(IHARG(2).EQ.'ON')GOTO8610
      IF(IHARG(1).EQ.'OFF')GOTO8610
      IF(IHARG(2).EQ.'OFF')GOTO8610
      GOTO8699
 8610 CONTINUE
      CALL DPSPSW(IHARG,NUMARG,IDEFSS,MAXSPI,ISPISW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8699 CONTINUE
C
C               *************************************
C               **  TREAT THE SPIKE (PATTERN) CASE **
C               **  (SAME AS SPIKE LINES CASE)     **
C               *************************************
C
      IF(ICOM.EQ.'SPIK')GOTO8700
      GOTO8799
C
 8700 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPSPPA(IHARG,NUMARG,IDEFSL,MAXSPI,ISPILI,
      CALL DPSPPA(IHARG,IHARG2,NUMARG,IDEFSL,MAXSPI,ISPILI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8799 CONTINUE
C
C               ***************************************
C               **  TREAT THE SUBREGION (SWITCH) CASE**
C               ***************************************
C
      IF(ICOM.EQ.'SUBR')THEN
        IF(IHARG(1).EQ.'ON'.OR.IHARG(2).EQ.'ON'.OR.
     1     IHARG(1).EQ.'OFF'.OR.IHARG(2).EQ.'OFF')THEN
          CALL DPSBSW(IHARG,NUMARG,IDEFSB,MAXSUB,ISUBSW,
     1                IBUGP2,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               ***************************************
C               **  TREAT THE SUBREGION LIMITS   CASE**
C               ***************************************
C
      IF(ICOM.EQ.'SUBR')THEN
        CALL DPSBLI(ICOM,IHARG,IARGT,ARG,NUMARG,
     1              ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1              MAXSUB,
     1              IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C
C               ***************************
C               **  TREAT THE MINOR GRID CASE  **
C               ***************************
C
      IF(ICOM.EQ.'XGMI')GOTO8800
      IF(ICOM.EQ.'YGMI')GOTO8800
      IF(ICOM.EQ.'XYGM')GOTO8800
      IF(ICOM.EQ.'YXGM')GOTO8800
      IF(ICOM.EQ.'GMIN')GOTO8800
      IF(ICOM.EQ.'MINO')GOTO8800
      GOTO8899
C
 8800 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO8899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO8899
      CALL DPGRMN(ICOM,IHARG,NUMARG,IVGMSW,IHGMSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8899 CONTINUE
C
C               ****************************************************
C               **  TREAT THE MULTIPLOT (CORNER) COORDINATES CASE **
C               ****************************************************
C
      IF(ICOM.EQ.'MULT')GOTO9100
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      IF(ICOM.EQ.'MP')GOTO9100
      GOTO9199
C
 9100 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'CORN'.AND.
     1IHARG(2).EQ.'COOR')GOTO9111
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')
     1GOTO9130
      GOTO9199
 9111 CONTINUE
      ISHIFT=1
      GOTO9120
 9120 CONTINUE
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      GOTO9130
 9130 CONTINUE
      CALL DPMUCC(IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 9199 CONTINUE
C
C               ****************************************************
C               **  TREAT THE    END OF MULTIPLOT    CASE         **
C               ****************************************************
C
      IF(ICOM.EQ.'END')GOTO9200
CCCCC THE FOLLOWING 2 LINES WERE ADDED AUGUST 1990
      IF(ICOM.EQ.'EOMP')GOTO9210
      IF(ICOM.EQ.'EMP')GOTO9210
      GOTO9299
C
 9200 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'OF'.AND.
     1IHARG(2).EQ.'MULT')GOTO9210
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MULT')
     1GOTO9210
      GOTO9299
 9210 CONTINUE
      CALL DPENMU(IMPSW,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
     1IERASW,
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 9299 CONTINUE
C
C               ****************************************************
C               **  TREAT THE MULTIPLOT CASE                      **
C               ****************************************************
C
      IF(ICOM.EQ.'MULT')GOTO9300
CCCCC THE FOLLOWING LINE WAS ADDED AUGUST 1990
      IF(ICOM.EQ.'MP')GOTO9300
      GOTO9399
C
 9300 CONTINUE
CCCCC FOLLOWING LINE ADDED SEPTEMBER 1998.
CCCCC FOLLOWING LINE ADDED SEPTEMBER 1998.
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO9399
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND.
     1IHARG2(1).EQ.'    ')
     1GOTO9311
      GOTO9330
 9311 CONTINUE
      ISHIFT=1
      GOTO9320
 9320 CONTINUE
      CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      GOTO9330
 9330 CONTINUE
      CALL DPMULT(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1IMPSW,IMPNR,IMPNC,IMPCO,
CCCCC ADD FOLLOWING LINE.  AUGUST 1999.
     1IMPARG,
CCCCC ADD FOLLOWING LINE.  SEPTEMBER 1998.
     1AMPSCH,AMPSCW,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASW,
     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 9399 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990
C               *************************************
C               **  TREAT THE WINDOW SYSTEM   CASE **
C               *************************************
C
      IF(ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'SYST')GOTO11100
      IF(ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'MANA')GOTO11100
      GOTO11199
C
11100 CONTINUE
      CALL DPWISY(IHARG,NUMARG,IDEFWS,IWINSY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11199 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED AUGUST 1990
C               *************************************
C               **  TREAT THE WINDOW POINTER CASE  **
C               *************************************
C
      IF(ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'POIN')GOTO11200
      IF(ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'SELE')GOTO11200
      GOTO11299
C
11200 CONTINUE
      CALL DPWIPO(IHARG,NUMARG,IDEFWP,IWINPO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11299 CONTINUE
C
C               ***********************************
C               **  TREAT THE PIXMAP TITLE CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'PIXM'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'TITL')
     1GOTO11300
      GOTO11399
C
11300 CONTINUE
      CALL DPPMTI(IANS,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11399 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPC.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAIPC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGPC,IBUGP2
 9013 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU
 9017 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9041)IMPSW,IMPNR,IMPNC,IMPCO
 9041 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9042 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IERASV
 9043 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9044 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IERASW
 9045 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9046 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)PXMIN,PXMAX,PYMIN,PYMAX
 9047 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE MAIPC3(IBUGPC,IBUGP2,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IERASV,
     1PWXMIS,PWXMAS,PWYMIS,PWYMAS,
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1992
     1BARHEF,BARWEF,
     1IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAIPC3.
C              (THE   PC    AT THE END OF    MAIPC3   STANDS FOR PLOT CONTROL
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES
C              PLOT CONTROL COMMANDS (PART 3).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--JULY 1986.
C     UPDATED        --APRIL  1992.  BAR EXPANSION FACTORS ... ...
C     UPDATED        --OCTOBER1993.  ARGUMENTS TO BAR BASE (DPBABA)
C     UPDATED        --OCTOBER1993.  ARGUMENTS TO REGION BASE (DPREBA)
C     UPDATED        --MARCH  1994.  ARGUMENTS TO REGION BASE (DPREBA)
C     UPDATED        --AUGUST    1995. DASH2 BUG (VARIOUS)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGPC
      CHARACTER*4 IBUGP2
C
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
C
      CHARACTER*4 IMPSW
      CHARACTER*4 IERASV
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.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
      IF(IBUGPC.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAIPC3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGPC,IBUGP2
   53 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,60)INEGAT,IFOUND,IERROR
CCC60 FORMAT('INEGSW,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,81)IMPSW,IMPNR,IMPNC,IMPCO
   81 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)PMXMIN,PMXMAX,PMYMIN,PMYMAX
   82 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IERASV
   83 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)PWXMIS,PWXMAS,PWYMIS,PWYMAS
   84 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IERASW
   85 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   86 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)PXMIN,PXMAX,PYMIN,PYMAX
   87 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
C               *****************************************
C               **  TREAT THE ORIENTATION SWITCH CASE  **
C               *****************************************
C
C
      IF(ICOM.EQ.'ORIE')GOTO51100
      GOTO51199
C
51100 CONTINUE
      CALL DPORSW(IHARG,NUMARG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
51199 CONTINUE
C
C     ----------BARS--------------------------------------------------
C
C               ******************************************
C               **  STEP XX--                           **
C               **  TREAT THE VARIOUS BAR ... COMMANDS  **
C               ******************************************
C
      IF(ICOM.EQ.'BAR')GOTO11000
      GOTO19999
11000 CONTINUE
C
C               **********************************************
C               **  TREAT THE BAR PATTERN LINE (TYPE)  CASE **
C               **********************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO11120
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE')GOTO11100
      GOTO11199
C
11100 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(3)='TYPE'
      IHARG2(3)='    '
11120 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPBPLI(IHARG,NUMARG,IDEBPL,MAXBAR,IBAPLI,
      CALL DPBPLI(IHARG,IHARG2,NUMARG,IDEBPL,MAXBAR,IBAPLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11199 CONTINUE
C
C               ****************************************
C               **  TREAT THE BAR PATTERN COLOR  CASE **
C               ****************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'COLO')GOTO11200
      GOTO11299
C
11200 CONTINUE
      CALL DPBPCO(IHARG,NUMARG,IDEBPC,MAXBAR,IBAPCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11299 CONTINUE
C
C               ********************************************
C               **  TREAT THE BAR PATTERN THICKNESS  CASE **
C               ********************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'THIC')GOTO11300
      GOTO11399
C
11300 CONTINUE
      CALL DPBPTH(IHARG,IARGT,ARG,NUMARG,PDEBPT,MAXBAR,PBAPTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11399 CONTINUE
C
C               ********************************************
C               **  TREAT THE BAR PATTERN SPACING    CASE **
C               ********************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'SPAC')GOTO11420
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'SPAC')GOTO11400
      GOTO11499
C
11400 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='PATT'
      IHARG2(2)='ERN '
11420 CONTINUE
      CALL DPBPSP(IHARG,IARGT,ARG,NUMARG,PDEBPS,MAXBAR,PBAPSP,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11499 CONTINUE
C
C               *******************************************
C               **  TREAT THE BAR PATTERN (TYPE)  CASE   **
C               *******************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'TYPE')GOTO11520
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'PATT')GOTO11500
      GOTO11599
C
11500 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='TYPE'
      IHARG2(2)='    '
11520 CONTINUE
      CALL DPBPTY(IHARG,NUMARG,IDEBPT,MAXBAR,IBAPTY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11599 CONTINUE
C
C               *************************************
C               **  TREAT THE BAR FILL COLOR  CASE **
C               *************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'COLO')GOTO11750
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'COLO')GOTO11710
      GOTO11799
C
11710 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(1)='FILL'
      IHARG2(1)='    '
      IHARG(2)='COLO'
      IHARG2(2)='    '
      GOTO11750
C
11750 CONTINUE
      CALL DPBFCO(IHARG,NUMARG,IDEBFC,MAXBAR,IBAFCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11799 CONTINUE
C
C               ****************************************
C               **  TREAT THE BAR FILL (SWITCH) CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'SWIT')GOTO11820
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'FILL')GOTO11800
      GOTO11899
C
11800 CONTINUE
CCCCC IF(IHARG(1).EQ.'ON')GOTO11810    MAY 5, 1987   FOR BAR SHADING
CCCCC IF(IHARG(2).EQ.'ON')GOTO11810    MAY 5, 1987   FOR BAR SHADING
CCCCC IF(IHARG(1).EQ.'OFF')GOTO11810    MAY 5, 1987   FOR BAR SHADING
CCCCC IF(IHARG(2).EQ.'OFF')GOTO11810    MAY 5, 1987   FOR BAR SHADING
CCCCC GOTO11899                       MAY 5, 1987 FOR BAR SHADING
      GOTO11810
11810 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='SWIT'
      IHARG2(2)='CH  '
11820 CONTINUE
      CALL DPBFSW(IHARG,NUMARG,IDEBFS,MAXBAR,IBAFSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11899 CONTINUE
C
C               ***************************************
C               **  TREAT THE BAR BORDER COLOR  CASE **
C               ***************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'COLO')GOTO12100
      GOTO12199
C
12100 CONTINUE
      CALL DPBBCO(IHARG,NUMARG,IDEBBC,MAXBAR,IBABCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12199 CONTINUE
C
C               *******************************************
C               **  TREAT THE BAR BORDER THICKNESS  CASE **
C               *******************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'THIC')GOTO12200
      GOTO12299
C
12200 CONTINUE
      CALL DPBBTH(IHARG,IARGT,ARG,NUMARG,PDEBBT,MAXBAR,PBABTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12299 CONTINUE
C
C               ***********************************************
C               **  TREAT THE BAR BORDER LINE (TYPE)  CASE   **
C               ***********************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO12330
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'TYPE')GOTO12320
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE')GOTO12320
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BORD')GOTO12310
      GOTO12399
C
12310 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO12330
C
12320 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO12330
C
12330 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPBBLI(IHARG,NUMARG,IDEBBL,MAXBAR,IBABLI,
      CALL DPBBLI(IHARG,IHARG2,NUMARG,IDEBBL,MAXBAR,IBABLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12399 CONTINUE
C
C               *************************************
C               **  TREAT THE BAR   WIDTH     CASE **
C               *************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'WIDT')GOTO12500
      GOTO12599
C
12500 CONTINUE
      CALL DPBAWI(IHARG,IARGT,ARG,NUMARG,ADEBWI,MAXBAR,ABARWI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12599 CONTINUE
C
C               ********************************
C               **  TREAT THE BAR   BASE CASE **
C               ********************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'BASE')GOTO12600
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'REFE')GOTO12600
      GOTO12699
C
12600 CONTINUE
CCCCC OCTOBER 1993.  MODIFY CALL LIST (DPCOHK.INC NOW IN SUBROUTINE)
CCCCC CALL DPBABA(IHARG,IARGT,ARG,NUMARG,ADEBBA,MAXBAR,ABARBA,
      CALL DPBABA(ADEBBA,MAXBAR,ABARBA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12699 CONTINUE
C
C               ***********************************
C               **  TREAT THE BAR   (SWITCH) CASE**
C               ***********************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'SWIT')GOTO12720
      IF(ICOM.EQ.'BAR')GOTO12700
      GOTO12799
C
12700 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO12710
      IF(IHARG(2).EQ.'ON')GOTO12710
      IF(IHARG(1).EQ.'OFF')GOTO12710
      IF(IHARG(2).EQ.'OFF')GOTO12710
      GOTO12799
12710 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(1)='SWIT'
      IHARG2(1)='CH  '
12720 CONTINUE
      CALL DPBASW(IHARG,NUMARG,IDEBSW,MAXBAR,IBARSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12799 CONTINUE
C
C               *************************************
C               **  TREAT THE BAR  DIMENSION  CASE **
C               *************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'DIME')GOTO12800
      GOTO12899
C
12800 CONTINUE
      CALL DPBATY(IHARG,NUMARG,IDEBTY,MAXBAR,IBARTY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12899 CONTINUE
C
C               ****************************************
C               **  TREAT THE BAR   DIRECTION    CASE **
C               ****************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'DIRE')GOTO12900
      GOTO12999
C
12900 CONTINUE
      CALL DPBADI(IHARG,NUMARG,IDEBDI,MAXBAR,IBARDI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12999 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1992
C               **********************************************
C               **  TREAT THE BAR   EXPANSION FACTORS  CASE **
C               **  (USED ONLY BY BLOCK PLOT COMMAND)       **
C               **********************************************
C
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'EXPA')GOTO13000
      IF(ICOM.EQ.'BAR'.AND.IHARG(1).EQ.'FACT')GOTO13000
      GOTO13099
C
13000 CONTINUE
      CALL DPBAEF(IHARG,IARGT,ARG,NUMARG,BARHEF,BARWEF,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13099 CONTINUE
C
C               **********************************
C               **  END POINT FOR BAR COMMANDS  **
C               **********************************
C
19999 CONTINUE
C
C     ----------END OF BARS---------------------------------------
C
C     ----------REGIONS-----------------------------------------------
C
C               ********************************************
C               **  STEP XX--                             **
C               **  TREAT THE VARIOUS REGION ... COMMANDS **
C               ********************************************
C
      IF(ICOM.EQ.'REGI')GOTO21000
      GOTO22999
21000 CONTINUE
C
C               *************************************************
C               **  TREAT THE REGION PATTERN LINE (TYPE)  CASE **
C               *************************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO21120
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE')GOTO21100
      GOTO21199
C
21100 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(3)='TYPE'
      IHARG2(3)='    '
21120 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPRPLI(IHARG,NUMARG,IDERPL,MAXREG,IREPLI,
      CALL DPRPLI(IHARG,IHARG2,NUMARG,IDERPL,MAXREG,IREPLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21199 CONTINUE
C
C               *******************************************
C               **  TREAT THE REGION PATTERN COLOR  CASE **
C               *******************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'COLO')GOTO21200
      GOTO21299
C
21200 CONTINUE
      CALL DPRPCO(IHARG,NUMARG,IDERPC,MAXREG,IREPCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21299 CONTINUE
C
C               ***********************************************
C               **  TREAT THE REGION PATTERN THICKNESS  CASE **
C               ***********************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'THIC')GOTO21300
      GOTO21399
C
21300 CONTINUE
      CALL DPRPTH(IHARG,IARGT,ARG,NUMARG,PDERPT,MAXREG,PREPTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21399 CONTINUE
C
C               ***********************************************
C               **  TREAT THE REGION PATTERN SPACING    CASE **
C               ***********************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'SPAC')GOTO21400
      GOTO21499
C
21400 CONTINUE
      CALL DPRPSP(IHARG,IARGT,ARG,NUMARG,PDERPS,MAXREG,PREPSP,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21499 CONTINUE
C
C               **********************************************
C               **  TREAT THE REGION PATTERN (TYPE)  CASE   **
C               **********************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'TYPE')GOTO21520
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'PATT')GOTO21500
      GOTO21599
C
21500 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='TYPE'
      IHARG2(2)='    '
21520 CONTINUE
      CALL DPRPTY(IHARG,NUMARG,IDERPT,MAXREG,IREPTY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21599 CONTINUE
C
C               ****************************************
C               **  TREAT THE REGION FILL COLOR  CASE **
C               ****************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'COLO')GOTO21750
CCCCC JANUARY, 1991.  CHECK FOR "REGIS COLOR" COMMAND.
CCCCC IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'COLO')GOTO21710
      IF(ICOM.EQ.'REGI'.AND.ICOM2.NE.'S   '.AND.IHARG(1).EQ.'COLO')
     *  GOTO21710
      GOTO21799
C
21710 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(1)='FILL'
      IHARG2(1)='    '
      IHARG(2)='COLO'
      IHARG2(2)='    '
      GOTO21750
C
21750 CONTINUE
      CALL DPRFCO(IHARG,NUMARG,IDERFC,MAXREG,IREFCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21799 CONTINUE
C
C               *******************************************
C               **  TREAT THE REGION FILL (SWITCH) CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'SWIT')GOTO21820
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'FILL')GOTO21800
      GOTO21899
C
21800 CONTINUE
CCCCC IF(IHARG(1).EQ.'ON')GOTO21810      MAY 5, 1987 FOR 3D FIGURES
CCCCC IF(IHARG(2).EQ.'ON')GOTO21810      MAY 5, 1987 FOR 3D FIGURES
CCCCC IF(IHARG(1).EQ.'OFF')GOTO21810      MAY 5, 1987 FOR 3D FIGURES
CCCCC IF(IHARG(2).EQ.'OFF')GOTO21810      MAY 5, 1987 FOR 3D FIGURES
CCCCC GOTO21899                            MAY 5, 1987 FOR 3D FIGURES
      GOTO21810
21810 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='SWIT'
      IHARG2(2)='CH  '
21820 CONTINUE
      CALL DPRFSW(IHARG,NUMARG,IDERFS,MAXREG,IREFSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
21899 CONTINUE
C
C               ******************************************
C               **  TREAT THE REGION BORDER COLOR  CASE **
C               ******************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'COLO')GOTO22100
      GOTO22199
C
22100 CONTINUE
      CALL DPRBCO(IHARG,NUMARG,IDERBC,MAXREG,IREBCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
22199 CONTINUE
C
C               **********************************************
C               **  TREAT THE REGION BORDER THICKNESS  CASE **
C               **********************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'THIC')GOTO22200
      GOTO22299
C
22200 CONTINUE
      CALL DPRBTH(IHARG,IARGT,ARG,NUMARG,PDERBT,MAXREG,PREBTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
22299 CONTINUE
C
C               **************************************************
C               **  TREAT THE REGION BORDER LINE (TYPE)  CASE   **
C               **************************************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO22330
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'TYPE')GOTO22320
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE')GOTO22320
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BORD')GOTO22310
      GOTO22399
C
22310 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO22330
C
22320 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO22330
C
22330 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPRBLI(IHARG,NUMARG,IDERBL,MAXREG,IREBLI,
      CALL DPRBLI(IHARG,IHARG2,NUMARG,IDERBL,MAXREG,IREBLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
22399 CONTINUE
C
C               ***********************************
C               **  TREAT THE REGION   BASE CASE **
C               ***********************************
C
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'BASE')GOTO22600
      IF(ICOM.EQ.'REGI'.AND.IHARG(1).EQ.'REFE')GOTO22600
      GOTO22699
C
22600 CONTINUE
CCCCC OCTOBER 1993.  CHANGE ARGUMENT LIST (INCLUDE FILES IN SUBROUTINE)
CCCCC MARCH 1994.    ADD IREBPL TO ARGUMENT LIST.
      CALL DPREBA(ADERBA,MAXREG,AREGBA,IREBIN,IREBPL,
CCCCC CALL DPREBA(ADERBA,MAXREG,AREGBA,IREBIN,
CCCCC CALL DPREBA(IHARG,IARGT,ARG,NUMARG,ADERBA,MAXREG,AREGBA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
22699 CONTINUE
C
C               *************************************
C               **  END POINT FOR REGION COMMANDS  **
C               *************************************
C
22999 CONTINUE
C
C     ----------END OF REGIONS------------------------------------------
C
C     ----------MARKERS-------------------------------------------------
C
C               *********************************************
C               **  STEP XX--                              **
C               **  TREAT THE VARIOUS MARKER ... COMMANDS  **
C               *********************************************
C
      IF(ICOM.EQ.'MARK')GOTO31000
      GOTO32999
31000 CONTINUE
C
C               *************************************************
C               **  TREAT THE MARKER PATTERN LINE (TYPE)  CASE **
C               *************************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO31120
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE')GOTO31100
      GOTO31199
C
31100 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(3)='TYPE'
      IHARG2(3)='    '
31120 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPMPLI(IHARG,NUMARG,IDEMPL,MAXMAR,IMAPLI,
      CALL DPMPLI(IHARG,IHARG2,NUMARG,IDEMPL,MAXMAR,IMAPLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31199 CONTINUE
C
C               *******************************************
C               **  TREAT THE MARKER PATTERN COLOR  CASE **
C               *******************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'COLO')GOTO31200
      GOTO31299
C
31200 CONTINUE
      CALL DPMPCO(IHARG,NUMARG,IDEMPC,MAXMAR,IMAPCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31299 CONTINUE
C
C               ***********************************************
C               **  TREAT THE MARKER PATTERN THICKNESS  CASE **
C               ***********************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'THIC')GOTO31300
      GOTO31399
C
31300 CONTINUE
      CALL DPMPTH(IHARG,IARGT,ARG,NUMARG,PDEMPT,MAXMAR,PMAPTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31399 CONTINUE
C
C               ***********************************************
C               **  TREAT THE MARKER PATTERN SPACING    CASE **
C               ***********************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'SPAC')GOTO31400
      GOTO31499
C
31400 CONTINUE
      CALL DPMPSP(IHARG,IARGT,ARG,NUMARG,PDEMPS,MAXMAR,PMAPSP,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31499 CONTINUE
C
C               **********************************************
C               **  TREAT THE MARKER PATTERN (TYPE)  CASE   **
C               **********************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'TYPE')GOTO31520
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'PATT')GOTO31500
      GOTO31599
C
31500 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='TYPE'
      IHARG2(2)='    '
31520 CONTINUE
      CALL DPMPTY(IHARG,NUMARG,IDEMPT,MAXMAR,IMAPTY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31599 CONTINUE
C
C               ****************************************
C               **  TREAT THE MARKER FILL COLOR  CASE **
C               ****************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'COLO')GOTO31750
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'COLO')GOTO31710
      GOTO31799
C
31710 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(1)='FILL'
      IHARG2(1)='    '
      IHARG(2)='COLO'
      IHARG2(2)='    '
      GOTO31750
C
31750 CONTINUE
      CALL DPMFCO(IHARG,NUMARG,IDEMFC,MAXMAR,IMAFCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31799 CONTINUE
C
C               *******************************************
C               **  TREAT THE MARKER FILL (SWITCH) CASE  **
C               *******************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'SWIT')GOTO31820
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'FILL')GOTO31800
      GOTO31899
C
31800 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO31810
      IF(IHARG(2).EQ.'ON')GOTO31810
      IF(IHARG(1).EQ.'OFF')GOTO31810
      IF(IHARG(2).EQ.'OFF')GOTO31810
      GOTO31899
31810 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='SWIT'
      IHARG2(2)='CH  '
31820 CONTINUE
      CALL DPMFSW(IHARG,NUMARG,IDEMFS,MAXMAR,IMAFSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
31899 CONTINUE
C
C               ******************************************
C               **  TREAT THE MARKER BORDER COLOR  CASE **
C               ******************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'COLO')GOTO32100
      GOTO32199
C
32100 CONTINUE
      CALL DPMBCO(IHARG,NUMARG,IDEMBC,MAXMAR,IMABCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
32199 CONTINUE
C
C               **********************************************
C               **  TREAT THE MARKER BORDER THICKNESS  CASE **
C               **********************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'THIC')GOTO32200
      GOTO32299
C
32200 CONTINUE
      CALL DPMBTH(IHARG,IARGT,ARG,NUMARG,PDEMBT,MAXMAR,PMABTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
32299 CONTINUE
C
C               **************************************************
C               **  TREAT THE MARKER BORDER LINE (TYPE)  CASE   **
C               **************************************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO32330
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'TYPE')GOTO32320
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE')GOTO32320
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BORD')GOTO32310
      GOTO32399
C
32310 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO32330
C
32320 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO32330
C
32330 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPMBLI(IHARG,NUMARG,IDEMBL,MAXMAR,IMABLI,
      CALL DPMBLI(IHARG,IHARG2,NUMARG,IDEMBL,MAXMAR,IMABLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
32399 CONTINUE
C
C               ***********************************
C               **  TREAT THE MARKER   BASE CASE **
C               ***********************************
C
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'BASE')GOTO32600
      IF(ICOM.EQ.'MARK'.AND.IHARG(1).EQ.'REFE')GOTO32600
      GOTO32699
C
32600 CONTINUE
      CALL DPMABA(IHARG,IARGT,ARG,NUMARG,ADEMBA,MAXMAR,AMARBA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
32699 CONTINUE
C
C               *************************************
C               **  END POINT FOR MARKER COMMANDS  **
C               *************************************
C
32999 CONTINUE
C
C     ----------END OF MARKERS---------------------------------------
C
C     ----------TEXTS--------------------------------------------------
C
C               *******************************************
C               **  STEP XX--                            **
C               **  TREAT THE VARIOUS TEXT ... COMMANDS  **
C               *******************************************
C
      IF(ICOM.EQ.'TEXT')GOTO41000
      GOTO42999
41000 CONTINUE
C
C               ***********************************************
C               **  TREAT THE TEXT PATTERN LINE (TYPE)  CASE **
C               ***********************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO41120
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'LINE')GOTO41100
      GOTO41199
C
41100 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(3)='TYPE'
      IHARG2(3)='    '
41120 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPTPLI(IHARG,NUMARG,IDETPL,MAXTEX,ITEPLI,
      CALL DPTPLI(IHARG,IHARG2,NUMARG,IDETPL,MAXTEX,ITEPLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41199 CONTINUE
C
C               *****************************************
C               **  TREAT THE TEXT PATTERN COLOR  CASE **
C               *****************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'COLO')GOTO41200
      GOTO41299
C
41200 CONTINUE
      CALL DPTPCO(IHARG,NUMARG,IDETPC,MAXTEX,ITEPCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41299 CONTINUE
C
C               *********************************************
C               **  TREAT THE TEXT PATTERN THICKNESS  CASE **
C               *********************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'THIC')GOTO41300
      GOTO41399
C
41300 CONTINUE
      CALL DPTPTH(IHARG,IARGT,ARG,NUMARG,PDETPT,MAXTEX,PTEPTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41399 CONTINUE
C
C               *********************************************
C               **  TREAT THE TEXT PATTERN SPACING    CASE **
C               *********************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'SPAC')GOTO41400
      GOTO41499
C
41400 CONTINUE
      CALL DPTPSP(IHARG,IARGT,ARG,NUMARG,PDETPS,MAXTEX,PTEPSP,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41499 CONTINUE
C
C               ********************************************
C               **  TREAT THE TEXT PATTERN (TYPE)  CASE   **
C               ********************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT'.AND.
     1IHARG(2).EQ.'TYPE')GOTO41520
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'PATT')GOTO41500
      GOTO41599
C
41500 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='TYPE'
      IHARG2(2)='    '
41520 CONTINUE
      CALL DPTPTY(IHARG,NUMARG,IDETPT,MAXTEX,ITEPTY,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41599 CONTINUE
C
C               **************************************
C               **  TREAT THE TEXT FILL COLOR  CASE **
C               **************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'COLO')GOTO41750
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'COLO')GOTO41710
      GOTO41799
C
41710 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(1)='FILL'
      IHARG2(1)='    '
      IHARG(2)='COLO'
      IHARG2(2)='    '
      GOTO41750
C
41750 CONTINUE
      CALL DPTFCO(IHARG,NUMARG,IDETFC,MAXTEX,ITEFCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41799 CONTINUE
C
C               *****************************************
C               **  TREAT THE TEXT FILL (SWITCH) CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'FILL'.AND.
     1IHARG(2).EQ.'SWIT')GOTO41820
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'FILL')GOTO41800
      GOTO41899
C
41800 CONTINUE
      IF(IHARG(1).EQ.'ON')GOTO41810
      IF(IHARG(2).EQ.'ON')GOTO41810
      IF(IHARG(1).EQ.'OFF')GOTO41810
      IF(IHARG(2).EQ.'OFF')GOTO41810
      GOTO41899
41810 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='SWIT'
      IHARG2(2)='CH  '
41820 CONTINUE
      CALL DPTFSW(IHARG,NUMARG,IDETFS,MAXTEX,ITEFSW,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
41899 CONTINUE
C
C               ****************************************
C               **  TREAT THE TEXT BORDER COLOR  CASE **
C               ****************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'COLO')GOTO42100
      GOTO42199
C
42100 CONTINUE
      CALL DPTBCO(IHARG,NUMARG,IDETBC,MAXTEX,ITEBCO,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
42199 CONTINUE
C
C               ********************************************
C               **  TREAT THE TEXT BORDER THICKNESS  CASE **
C               ********************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'THIC')GOTO42200
      GOTO42299
C
42200 CONTINUE
      CALL DPTBTH(IHARG,IARGT,ARG,NUMARG,PDETBT,MAXTEX,PTEBTH,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
42299 CONTINUE
C
C               ************************************************
C               **  TREAT THE TEXT BORDER LINE (TYPE)  CASE   **
C               ************************************************
C
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE'.AND.IHARG(3).EQ.'TYPE')GOTO42330
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'TYPE')GOTO42320
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD'.AND.
     1IHARG(2).EQ.'LINE')GOTO42320
      IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BORD')GOTO42310
      GOTO42399
C
42310 CONTINUE
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO42330
C
42320 CONTINUE
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGP2,IERROR)
      IHARG(2)='LINE'
      IHARG2(2)='    '
      IHARG(3)='TYPE'
      IHARG2(3)='    '
      GOTO42330
C
42330 CONTINUE
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC CALL DPTBLI(IHARG,NUMARG,IDETBL,MAXTEX,ITEBLI,
      CALL DPTBLI(IHARG,IHARG2,NUMARG,IDETBL,MAXTEX,ITEBLI,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
42399 CONTINUE
C
C               *********************************
C               **  TREAT THE TEXT   BASE CASE **
C               *********************************
C
CCCCC IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'BASE')GOTO42600
CCCCC IF(ICOM.EQ.'TEXT'.AND.IHARG(1).EQ.'REFE')GOTO42600
      GOTO42699
C
42600 CONTINUE
      CALL DPTEBA(IHARG,IARGT,ARG,NUMARG,ADETBA,MAXTEX,ATEXBA,
     1IBUGP2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
42699 CONTINUE
C
C               ***********************************
C               **  END POINT FOR TEXT COMMANDS  **
C               ***********************************
C
42999 CONTINUE
C
C
C     ----------END OF TEXTS---------------------------------------
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPC.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAIPC3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGPC,IBUGP2
 9013 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU
 9017 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9041)IMPSW,IMPNR,IMPNC,IMPCO
 9041 FORMAT('IMPSW,IMPNR,IMPNC,IMPCO = ',A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)PMXMIN,PMXMAX,PMYMIN,PMYMAX
 9042 FORMAT('PMXMIN,PMXMAX,PMYMIN,PMYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IERASV
 9043 FORMAT('IERASV = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)PWXMIS,PWXMAS,PWYMIS,PWYMAS
 9044 FORMAT('PWXMIS,PWXMAS,PWYMIS,PWYMAS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IERASW
 9045 FORMAT('IERASW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9046 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)PXMIN,PXMAX,PYMIN,PYMAX
 9047 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
      RETURN
      END
      SUBROUTINE MAIPC4(IBUGPC,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--THIS IS SUBROUTING MAIPC4.
C              (THE   PC    AT THE END OF    MAIPC4   STANDS FOR PLOT CONTROL
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES
C              PLOT CONTROL COMMANDS (PART 1).
C              THE PLOT CONTROL COMMANDS SEARCHED FOR BY MAIPC4
C              ARE THE FOLLOWING 3D-RELATED COMMANDS--
C
C                 EYE (COORDINATES)
C                 ORIGIN COORDINATES
C                 VISIBLE (HIDDENLINES, BACKLINES)
C                 PROJECTION
C
C                 PEDESTAL ON/OFF
C                 PEDESTAL BASE
C                 PEDESTAL SIZE
C                 PEDESTAL COLOR
C                 PEDESTAL GRID
C                 PEDESTAL GRID PATTERN
C                 PEDESTAL GRID COLOR
C
C                 BASEPLANE ON/OFF
C                 BASEPLANE COLOR
C                 BASEPLANE GRID
C                 BASEPLANE GRID PATTERN
C                 BASEPLANE GRID COLOR
C
C                 BACKPLANE ON/OFF
C                 BACKPLANE COLOR
C                 BACKPLANE GRID
C                 BACKPLANE GRID PATTERN
C                 BACKPLANE GRID COLOR
C
C                 SIDEFACE ON/OFF
C                 SIDEFACE COLOR
C                 SIDEFACE GRID
C                 SIDEFACE GRID PATTERN
C                 SIDEFACE GRID COLOR
C
C                 TIC PLANE
C
C                 ROTATE EYE
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER  --88.10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C     UPDATED         --APRIL     1992. DEPBA=DEFBA COMMENTED OUT
C     UPDATED         --SEPTEMBER 1993. ALLOW EYE FOR EYE COOR
C     UPDATED         --SEPTEMBER 1993. NEW COMMAND--ROTATE EYE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGPC
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCO3D.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
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(IBUGPC.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAIPC4--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGPC,IBUGP2
   53 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ICOM,ICOM2
   67 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
CCCCC THE FOLLOWING SECTION WAS REWRITTEN    SEPTEMBER 1993
C               ***************************************
C               **  TREAT THE EYE (COORDINATES) CASE **
C               ***************************************
C
      IF(ICOM.EQ.'EYE')THEN
         IF(NUMARG.GE.1)THEN
            IF(IHARG(1).EQ.'COOR')THEN
               ISHIFT=1
               CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,
     1         IARGT,NUMARG,IBUGPC,IERROR)
            ENDIF
         ENDIF
         CALL DPEYCO(IHARG,IARGT,ARG,NUMARG,
     1   AEYEXC,AEYEYC,AEYEZC,
     1   X3DEYE,Y3DEYE,Z3DEYE,
     1   IFOUND,IERROR)
         IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C               *****************************************
C               **  TREAT THE ORIGIN COORDINATES CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'ORIG')GOTO1200
      GOTO1299
C
 1200 CONTINUE
      CALL DPORCO(IHARG,IARGT,ARG,NUMARG,
     1AORIXC,AORIYC,AORIZC,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1299 CONTINUE
C
C               *******************************
C               **  TREAT THE VISIBLE CASE   **
C               **  HIDDEN LINES, BACKLINES  **
C               *******************************
C
      IF(ICOM.EQ.'VISI')GOTO1300
      IF(ICOM.EQ.'HIDD')GOTO1300
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'LINE')GOTO1300
      IF(ICOM.EQ.'BACK'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'LINE')
     1GOTO1300
      GOTO1399
C
 1300 CONTINUE
      CALL DPVIS(IHARG,NUMARG,IVISSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1399 CONTINUE
C
C               **************************************************
C               **  TREAT THE PROJECTION CASE (3D)              **
C               **************************************************
C
      IF(ICOM.EQ.'PROJ')GOTO1400
      IF(ICOM.EQ.'ORTH')GOTO1400
      IF(ICOM.EQ.'PERS')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      CALL DPPROJ(ICOM,IHARG,NUMARG,I3DPRO,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1499 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED    SEPTEMBER 1993
C               **************************************
C               **  TREAT THE ROTATE EYE CASE       **
C               **************************************
C
      IF(ICOM.EQ.'ROTA')THEN
         CALL DPROEY(IHARG,IARGT,ARG,NUMARG,
     1   X3DEYE,Y3DEYE,Z3DEYE,
     1   X3DMID,Y3DMID,Z3DMID,
     1   AEYEXC,AEYEYC,AEYEZC,
     1   IFOUND,IERROR)
         IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C     -----PEDESTAL-----
C
C               ******************************************
C               **  TREAT THE PEDESTAL GRID COLOR CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2100
      GOTO2199
C
 2100 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'COLO')GOTO2110
      GOTO2199
 2110 CONTINUE
      CALL DPPEGC(IHARG,NUMARG,IDEPGC,IPEDGC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2199 CONTINUE
C
C               *********************************************
C               **  TREAT THE PEDESTAL GRID PATTERN  CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2200
      GOTO2299
C
 2200 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'PATT')GOTO2210
      GOTO2299
 2210 CONTINUE
      CALL DPPEGP(IHARG,NUMARG,IDEPGP,IPEDGP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2299 CONTINUE
C
C               *************************************
C               **  TREAT THE PEDESTAL GRID  CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2300
      GOTO2399
C
 2300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GRID')GOTO2310
      GOTO2399
 2310 CONTINUE
      CALL DPPEGR(IHARG,NUMARG,IDEPGR,IPEDGR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2399 CONTINUE
C
C               *************************************
C               **  TREAT THE PEDESTAL COLOR CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2400
      GOTO2499
C
 2400 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO2410
      GOTO2499
 2410 CONTINUE
      CALL DPPECL(IHARG,NUMARG,IDEPCO,IPEDCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2499 CONTINUE
C
C               **************************************
C               **  TREAT THE PEDESTAL SIZE   CASE  **
C               **************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2500
      GOTO2599
C
 2500 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIZE')GOTO2510
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'HEIG')GOTO2510
      GOTO2599
 2510 CONTINUE
      CALL DPPESZ(IHARG,IARGT,ARG,NUMARG,
     1ADEPSZ,APEDSZ,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2599 CONTINUE
C
C               *************************************
C               **  TREAT THE PEDESTAL BASE  CASE  **
C               *************************************
C
      IF(ICOM.EQ.'PEDE')GOTO2600
      GOTO2699
C
 2600 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'BASE')GOTO2610
      GOTO2699
 2610 CONTINUE
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   APRIL 1992 (ALAN)
CCCCC DEPBA=DEFBA
      CALL DPPEBA(IHARG,IARGT,ARG,NUMARG,
     1ADEPBA,APEDBA,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2699 CONTINUE
C
C               *******************************
C               **  TREAT THE PEDESTAL CASE  **
C               *******************************
C
      IF(ICOM.EQ.'PEDE')GOTO2700
      GOTO2799
C
 2700 CONTINUE
      CALL DPPED(IHARG,NUMARG,IPEDSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2799 CONTINUE
C
C     -----BASEPLANE-----
C
C               ******************************************
C               **  TREAT THE BASEPLANE GRID COLOR CASE **
C               ******************************************
C
      IF(ICOM.EQ.'BASE')GOTO3100
      GOTO3199
C
 3100 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'COLO')GOTO3110
      GOTO3199
 3110 CONTINUE
      CALL DPBSGC(IHARG,NUMARG,IDBSGC,IBSPGC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3199 CONTINUE
C
C               *********************************************
C               **  TREAT THE BASEPLANE GRID PATTERN  CASE **
C               *********************************************
C
      IF(ICOM.EQ.'BASE')GOTO3200
      GOTO3299
C
 3200 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'PATT')GOTO3210
      GOTO3299
 3210 CONTINUE
      CALL DPBSGP(IHARG,NUMARG,IDBSGP,IBSPGP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3299 CONTINUE
C
C               *************************************
C               **  TREAT THE BASEPLANE GRID  CASE **
C               *************************************
C
      IF(ICOM.EQ.'BASE')GOTO3300
      GOTO3399
C
 3300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GRID')GOTO3310
      GOTO3399
 3310 CONTINUE
      CALL DPBSGR(IHARG,NUMARG,IDBSGR,IBSPGR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3399 CONTINUE
C
C               *************************************
C               **  TREAT THE BASEPLANE COLOR CASE **
C               *************************************
C
      IF(ICOM.EQ.'BASE')GOTO3400
      GOTO3499
C
 3400 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO3410
      GOTO3499
 3410 CONTINUE
      CALL DPBSCL(IHARG,NUMARG,IDBSCO,IBSPCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3499 CONTINUE
C
C               *******************************
C               **  TREAT THE BASEPLANE CASE **
C               *******************************
C
      IF(ICOM.EQ.'BASE')GOTO3500
      GOTO3599
C
 3500 CONTINUE
      CALL DPBSP(IHARG,NUMARG,IBSPSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3599 CONTINUE
C
C     -----BACKPLANE-----
C
C               ******************************************
C               **  TREAT THE BACKPLANE GRID COLOR CASE **
C               ******************************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'PLAN')GOTO4100
      GOTO4199
C
 4100 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'COLO')GOTO4110
      GOTO4199
 4110 CONTINUE
      CALL DPBKGC(IHARG,NUMARG,IDBKGC,IBKPGC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4199 CONTINUE
C
C               *********************************************
C               **  TREAT THE BACKPLANE GRID PATTERN  CASE **
C               *********************************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'PLAN')GOTO4200
      GOTO4299
C
 4200 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'PATT')GOTO4210
      GOTO4299
 4210 CONTINUE
      CALL DPBKGP(IHARG,NUMARG,IDBKGP,IBKPGP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4299 CONTINUE
C
C               *************************************
C               **  TREAT THE BACKPLANE GRID  CASE **
C               *************************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'PLAN')GOTO4300
      GOTO4399
C
 4300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GRID')GOTO4310
      GOTO4399
 4310 CONTINUE
      CALL DPBKGR(IHARG,NUMARG,IDBKGR,IBKPGR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4399 CONTINUE
C
C               *************************************
C               **  TREAT THE BACKPLANE COLOR CASE **
C               *************************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'PLAN')GOTO4400
      GOTO4499
C
 4400 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO4410
      GOTO4499
 4410 CONTINUE
      CALL DPBKCL(IHARG,NUMARG,IDBKCO,IBKPCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4499 CONTINUE
C
C               *******************************
C               **  TREAT THE BACKPLANE CASE **
C               *******************************
C
      IF(ICOM.EQ.'BACK'.AND.ICOM2.EQ.'PLAN')GOTO4500
      GOTO4599
C
 4500 CONTINUE
      CALL DPBKP(IHARG,NUMARG,IBKPSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4599 CONTINUE
C
C     -----SIDEFACE-----
C
C               ******************************************
C               **  TREAT THE SIDEFACE GRID COLOR CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'SIDE')GOTO5100
      GOTO5199
C
 5100 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'COLO')GOTO5110
      GOTO5199
 5110 CONTINUE
      CALL DPSDGC(IHARG,NUMARG,IDSDGC,ISDFGC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5199 CONTINUE
C
C               *********************************************
C               **  TREAT THE SIDEFACE GRID PATTERN  CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'SIDE')GOTO5200
      GOTO5299
C
 5200 CONTINUE
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'GRID'.AND.IHARG(2).EQ.'PATT')GOTO5210
      GOTO5299
 5210 CONTINUE
      CALL DPSDGP(IHARG,NUMARG,IDSDGP,ISDFGP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5299 CONTINUE
C
C               *************************************
C               **  TREAT THE SIDEFACE GRID  CASE  **
C               *************************************
C
      IF(ICOM.EQ.'SIDE')GOTO5300
      GOTO5399
C
 5300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GRID')GOTO5310
      GOTO5399
 5310 CONTINUE
      CALL DPSDGR(IHARG,NUMARG,IDSDGR,ISDFGR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5399 CONTINUE
C
C               *************************************
C               **  TREAT THE SIDEFACE COLOR CASE  **
C               *************************************
C
      IF(ICOM.EQ.'SIDE')GOTO5400
      GOTO5499
C
 5400 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO5410
      GOTO5499
 5410 CONTINUE
      CALL DPSDCL(IHARG,NUMARG,IDSDCO,ISDFCO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5499 CONTINUE
C
C               *******************************
C               **  TREAT THE SIDEFACE CASE  **
C               *******************************
C
      IF(ICOM.EQ.'SIDE')GOTO5500
      GOTO5599
C
 5500 CONTINUE
      CALL DPSDF(IHARG,NUMARG,ISDFSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5599 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGPC.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAIPC4--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGPC,IBUGP2
 9013 FORMAT('IBUGPC,IBUGP2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFOUND,IERROR
 9020 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)ICOM,ICOM2
 9027 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MAINSU(IDEFSE,ISEED,ANOPL1,ANOPL2,
     1ISQUAR,IBOOSS,IDEBOO,
     1IANSSV,IREPMX,ILISMX,IPOINT,
     1ISACNC,
     1IAUTSW,IAUTEX,
     1ITOPIC,
     1MAXNXT,
     1IPROSW,
CCCCC THE FOLLOWING LINE WAS AUGMENTED AUGUST 1994
CCCCC1IMACRO,IMACNU,IMACCS,IOFILE,
CCCCC1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IOFILE,
CCCCC THE FOLLOWING LINE WAS AUGMENTED MARCH 1996
     1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IOFILE,IMALEV,
     1IPROGR,ICONCL,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
     1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA,
     1IBASLC,IREPCH,IOSW,ICAPSW,IPRDEF,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO,
CCCCC THE FOLLOWING LINE WAS AUGMENTED    MARCH 1992
CCCCC1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,IOUTTY,IPRITY,
CCCCC MARCH 1994.  ADD ALOWDG ARGUMENT.
CCCCC1IHELMX,IFTEXP,ALOWFR,
CCCCC1IHELMX,IFTEXP,ALOWFR,ALOWDG,
     1IHELMX,IFTEXP,IFTORD,ALOWFR,ALOWDG,
     1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF,IREARW,IWRIRW,
CCCCC FOLLOWING LINE ADDED APRIL 1995
     1IUNFOF,IUNFNR,IUNFMC,
CCCCC FOLLOWING LINE ADDED OCTOBER 1996
     1IRHSTG,IMPSW,
CCCCC FOLLOWING LINE ADDED SEPTEMBER 2003
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
CCCCC THE FOLLOWING LINE WAS FIXED   APRIL 1992
CCCCC1IFOUND,IERROR)
     1NPLOTP,IFOUND,IERROR)
C
CCCCC IBASLC WAS ADDED TO ABOVE INPUT ARGUMENT LIST       JUNE 1989
CCCCC ICAPSW AND IPRDEF WERE ADDED TO ABOVE ARGUMENT LIST JUNE 1989
C
C     PURPOSE--THIS IS SUBROUTING MAINSU.
C
C              (THE   SU    AT THE END OF    MAINSU   STANDS FOR   SUPPORT)
C              THIS SUBROUTINE SEARCHES FOR AND EXECUTES SUPPORT COMMANDS.
C              THE SUPPORT COMMANDS SEARCHED FOR BY MAINSU ARE AS FOLLOWS--
C
C                     ADD                            N/A                 ADD CAL
C                     ANOP LIMITS (= PROPORTION LIMITS)     +-INFINITY
C                     BAUD                           9600                BAUD 12
C                     BUGS                           N/A                 BUGS
C                     CLASS ... LOWER                AUTOMATIC           CLASS L
C                     CLASS ... UPPER                AUTOMATIC FROM DATA CLASS U
C                     CLASS ... WIDTH                AUTOMATIC FROM DATA CLASS W
C                     COLUMN LIMITS                  1 132               COLUMN
C                     COMMENT                        N/A                 COMMENT
C                     CURSOR SIZE                    1.0                 CURSOR
C                     DEFAULT COMMAND                NO COMMAND          DEFAULT
C                     DELETE                         N/A                 DELETE
C                     DEMODULATION FREQUENCY         0.25                DEMODUL
C                     DIMENSION                      1000 ROWS 10 COLS   DIMENSI
C                     DOUBLE PRECISION               OFF = SING. PREC.   DOUBLE
C                     ECHO                           OFF = NO ECHO       ECHO ON
C                     END                            N/A                 END
C                     ERASE DELAY                    1                   ERASE D
C                     FEEDBACK                       ON = FEEDBACK       FEEDBAC
C                     FILTER WIDTH                   3                   FILTER
C                     FIT CONSTRAINT                 ALL UNCONSTRAINED   FIT CON
C                     FIT ITERATIONS                 50                  FIT ITE
C                     FIT STANDARD DEVIATION         .000005             FIT STA
C                     HARDCOPY DELAY                 1                   HARDCOP
C                     HELP                           N/A                 HELP PL
C                     HOST                           THE    LOCAL    HOST    HOS
C                     HOST LINK                      THE    LOCAL    HOST    HOS
C                     IMPLEMENT                      ORIG. INITIALIZ.     IMPLEM
C                     KNOTS                          OFF = NO KNOTS      KNOTS K
C                     MACRO (CREATE)                 OFF                 MACRO
C                     MAIL                           N/A                 MAIL JO
C                     MAXIMUM RECORD LENGTH          N/A                 MAIL JO
C                     NAME                           N/A                 NAME Y
C                     NEWS                           N/A                 NEWS
C                     OPERATOR                       N/A                 OPERAT
C                     POLYNOMIAL DEGREE              1 = LINEAR          POLYNOM
C                     PRECISION                      SINGLE              PRECISI
C                     PRE-ERASE                      ON = PRE-ERASE      PRE-ERA
C                     PRINTING                       ON = PRINTING       PRINTIN
C                     PROBE                          N/A                 PROBE N
C                     QUADRUPLE PRECISION            OFF = SING. PREC.   QUADRUP
C                     QUERY                          N/A                 QUERY H
C                     READ                           N/A                 READ CA
C                     RESET                          N/A                 RESET
C                     RESTORE                        N/A                 RESTORE
C                     RETAIN                         N/A                 RETAIN
C                     ROW LIMITS                     1 INFINITY          ROW LIM
C                     SAVE                           N/A                 SAVE SC
C                     SEED                           20867350019         SEED
C                     TERMIANATOR CHARACTER          ;                   SEPAR
C                     SERIAL READ                    N/A                 SERIAL
C                     SET                            OFF                 SET IBU
C                     SINGLE PRECISION               ON                  SINGLE
C                     SKIP                           0 = NO LINES        SKIP 5
C                     STATUS                         N/A                 STATUS
C                     TIME                           N/A                 TIME
C                     TRIPLE PRECISION               OFF = SING. PREC.   TRIPLE
C                     WEIGHTS                        OFF = EQUI-WEIGHTED WEIGHTS
C                     WRITE                          N/A                 WRITE C
C                     .                              N/A                 . CARRY
C                     CONTINUE CHARACTER             ...                 CONTI
C                     SYSTEM                         N/A                 SYSTE
C                     PRINTER FORMAT ASCII/POSTSCRIPT
C                     FILE FORMAT ASCII/POSTSCRIPT
C
C                     VECTOR FORMAT <ANGLE/POINT/DELTA>
C                     VECTOR ARROW  <FIXED/VARIABLE>
C                     VECTOR ARROW  <OPEN/CLOSED>
C                     ANDREWS INCREMENT
C                     OPTIMIZATION METHOD
C                     WEB HELP
C                     RECIPE SATTERWAITE APPROXIMATION
C                     RECIPE OUTPUT
C                     RECIPE PROBABILITY CONTENT (OR RECIPE CONTENT)
C                     RECIPE CONFIDENCE
C                     RECIPE FIT DEGREE (OR RECIPE DEGREE)
C                     RECIPE ANOVA FACTORS (OR RECIPE FACTORS)
C                     RECIPE CORRELATION
C                     RECIPE SIMCOV REPLICATES
C                     RECIPE SIMPVT REPLICATES
C
C                     GUI WRITE/PRINT
C                     GUI STATUS
C                     GUI PLOT CONTROL <N>
C
C                     VARIABLE LABEL
C
C                     ORTHOGONAL DISTANCE ERROR 
C                     ORTHOGONAL DISTANCE DELTA 
C
C                     KERNEL DENSITY WIDTH
C                     KERNEL DENSITY POINTS
C
C                     AUTO TEXT
C
C                     PROCES ID (OR PID)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1983.
C     UPDATED         --JANUARY   1986.
C     UPDATED         --OCTOBER   1987. (ISUBRO FOR DPAPPE AND DPEXTE)
C     UPDATED         --AUGUST    1988. EQUATE PROPORTION LIMITS WITH ANOP LIM
C     UPDATED         --DECEMBER  1988. ADJUST RESET FOR RESET2
C     UPDATED         --DECEMBER  1988. RESET DATA, IO, PC, ETC.
C     UPDATED         --DECEMBER  1988. SET WRITE FORMAT
C     UPDATED         --DECEMBER  1988.  SET READ  REWIND
C     UPDATED         --DECEMBER  1988.  SET WRITE REWIND
C     UPDATED         --DECEMBER  1988.  LOWESS FRACTION
C     UPDATED         --DECEMBER  1988.  READ/WRITE DECI, FORMAT, REWIND
C     UPDATED         --JANUARY   1989.  BOOTSTRAP SAMPLE SIZE
C     UPDATED         --FEBRUARY  1989.  CONTINUE CHARACTER (ALAN)
C     UPDATED         --FEBRUARY  1989.  SOFT-CODED LIMITS FOR IANSSV (ALAN)
C     UPDATED         --FEBRUARY  1989.  SYSTEM COMMAND (ALAN)
C     UPDATED         --JUNE      1989.  REPLACEMENT/SUBSTITUTION CHARACTER
C     UPDATED         --JUNE      1989.  CAPTURE (TEXT OUTPUT)
C     UPDATED         --JULY      1989.  MORE/PAUSE TO LIST
C     UPDATED         --NOVEMBER  1989.  COLUMN RULER
C     UPDATED         --NOVEMBER  1989.  NLIST
C     UPDATED         --NOVEMBER  1989.  ADD ARG TO CALL TO DPSYST
C     UPDATED         --MARCH     1990.  ADD ARGUMENT TO SYSTEM COMMAND (ALAN)
C     UPDATED         --MAY       1990.  ADD ARGUMENTS TO DPREAD, DPREAL
C     UPDATED         --MAY       1990.  COMMENT CHARACTER COMMAND
C     UPDATED         --JUNE      1990.  IBUGD2 TO IBUGS2 IN CALL TO DPSYST
C     UPDATED         --JULY      1990.  ICOMFL RENAMED AS ICOMSW
C     UPDATED         --SEPTEMBER 1990.  DOS, UNIX, ETC. FOR SYSTEM
C     UPDATED         --SEPTEMBER 1990.  DATE SYNONYM FOR TIME
C     UPDATED         --MARCH     1992.  PRINTER FORMAT ASCI/POST
C     UPDATED         --MARCH     1992.  FILE FORMAT ASCI/POST
C     UPDATED         --APRIL     1992.  ADD NPLOTP TO ARGS
C     UPDATED         --AUGUST    1992.  VECTOR FORMAT, VECTOR ARROW
C     UPDATED         --SEPTEMBER 1992.  LIST SYNONYMS: VIEW/PREVIEW
C     UPDATED         --NOVEMBER  1992.  ANDREWS INCREMENT
C     UPDATED         --JULY      1993.  FRACTAL ITERATIONS
C     UPDATED         --JULY      1993.  FRACTAL TYPE
C     UPDATED         --JULY      1993.  PRINCIPLE COMPONENT TYPE
C     UPDATED         --JULY      1993.  ADD ARGS TO DPLICO: MORE
C     UPDATED         --SEPTEMBER 1993.  REWRITE CODE AROUND DPLICO
C     UPDATED         --DECEMBER  1993.  CHECK FOR "SAVE" AND "S CHART"
C                                        CONFLICT.
C     UPDATED         --JANUARY   1994.  SEARCH1
C     UPDATED         --MAY       1994.  COPY FILE => COPY
C     UPDATED         --JUNE      1994.  OPTIMIZATION TOLERANCE
C     UPDATED         --AUGUST    1994.  EXECUTE SUBSET OF MACRO
C     UPDATED         --SEPTEMBER 1994.  CHECK FOR NAME CONFLICT
C     UPDATED         --NOVEMBER  1994.  DECLARE NEWNAM (BOMB ON VAX)
C     UPDATED         --FEBRUARY  1995.  OPTIMIZATION METHOD
C     UPDATED         --APRIL     1995.  IUNFOF, IUNFNR, IUNFMC
C     UPDATED         --AUGUST    1995.  ADD IFTORD
C     UPDATED         --SEPTEMBER 1995.  ISUBRO ADDED TO CALL DPDELE
C     UPDATED         --SEPTEMBER 1995.  INIT COMMAND (FOR DEBUGGING)
C     UPDATED         --OCTOBER   1995.  NAME CONFLICT WITH DOUBLE
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --APRIL     1997.  WEB HELP COMMAND (ALAN)
C     UPDATED         --APRIL     1997.  LIST GRAPH (ALAN)
C     UPDATED         --APRIL     1997.  SAVE GRAPH (ALAN)
C     UPDATED         --APRIL     1997.  REPEAT GRAPH (ALAN)
C     UPDATED         --APRIL     1997.  CYCLE GRAPH (ALAN)
C     UPDATED         --AUGUST    1997.  SLEEP (= PAUSE <n>)
C     UPDATED         --AUGUST    1997.  CD COMMAND
C     UPDATED         --AUGUST    1997.  6 RECIPE COMMANDS
C     UPDATED         --NOVEMBER  1997.  GUI PRINT/WRITE
C     UPDATED         --NOVEMBER  1997.  GUI STATUS
C     UPDATED         --NOVEMBER  1997.  GUI SAVE PLOT CONTROL
C     UPDATED         --JANUARY   1998.  CALL TO DPDIME
C     UPDATED         --NOVEMBER  1998.  CALL LIST TO DPSET, DPPROB
C     UPDATED         --MARCH     1998.  NAME CONFLICT WITH CP AND CP PLOT
C     UPDATED         --APRIL     1997.  RECIPE FIT FACTORS COMMANDS
C     UPDATED         --MARCH     1999.  NAME CONFLICT FOR SINGLE
C     UPDATED         --NOVEMBER  1999.  VARIABLE LABEL
C     UPDATED         --APRIL     2001.  ORTHOGONAL DISTANCE ERROR
C     UPDATED         --APRIL     2001.  ORTHOGONAL DISTANCE DELTA
C     UPDATED         --AUGUST    2001.  KERNEL DENSITY WIDTH/POINTS
C     UPDATED         --JUNE      2002.  ICAPTY IN DPCAPT CALL
C     UPDATED         --FEBRUARY  2003.  CALL TO DPREAD, DPSERI
C     UPDATED         --FEBRUARY  2003.  CALL TO DPCOLL
C     UPDATED         --FEBRUARY  2003.  ADD: MAXIMUM RECORD LENGTH
C     UPDATED         --FEBRUARY  2003.  CALL LIST TO DPSEAR
C     UPDATED         --SEPTEMBER 2003.  CALL LIST TO DPWRIT
C     UPDATED         --SEPTEMBER 2005.  CALL LIST TO DPMACR
C     UPDATED         --SEPTEMBER 2005.  MACRO SUBSTITUTION CHARACTER
C     UPDATED         --JANUARY   2006.  ARGUMENT LIST TO DPCAPT
C     UPDATED         --MARCH     2006.  PROCESS ID
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 IMPSW
C
      CHARACTER*4 ISQUAR
      CHARACTER*4 ITOPIC
      CHARACTER*4 IPROSW
C
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
      CHARACTER*4 IOFILE
C
      CHARACTER*4 IPROGR
      CHARACTER*4 ICONCL
C
      CHARACTER*4 ICOM3
      CHARACTER*4 ICOM4
      CHARACTER*40 ICOM5
C
      CHARACTER*30 ICTRA1
      CHARACTER*30 ICTRA2
C
      CHARACTER*1 IBASLC
      CHARACTER*1 IREPCH
C
      CHARACTER*4 IOSW
C
CCCCC CHARACTER*4 ISUBN1
CCCCC CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
C
      CHARACTER*4 IBUGEX
      CHARACTER*4 IBUGE2
      CHARACTER*4 IBUGHE
      CHARACTER*4 IBUGH2
      CHARACTER*4 IBUGLO
C
      CHARACTER*40 ICPREH
      CHARACTER*40 ICPOSH
C
CCCCC THE FOLLOWING 2 LINES WERE ADDED    MARCH 1992
      CHARACTER*4 IPRITY
      CHARACTER*4 IOUTTY
C
      CHARACTER*4 IFTEXP
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IFTORD
C
      CHARACTER*4 IFORSW
      CHARACTER*80 ICREAF
      CHARACTER*80 ICWRIF
C
      CHARACTER*4 IREARW
      CHARACTER*4 IWRIRW
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IDEFHL
      CHARACTER*4 IHOSLI
C
      CHARACTER*1 IANSSV
      CHARACTER*80 ISACNC
C
      CHARACTER*4 IAUTSW
      CHARACTER*4 IAUTEX
C
      CHARACTER*4 IBELSJ
      CHARACTER*4 IERASJ
      CHARACTER*4 IBACCJ
      CHARACTER*4 ICOPSJ
C
      CHARACTER*4 ISEART
C
CCCCC THE FOLLOWING LINE WAS ADDED JUNE 1989
      CHARACTER*4 ICAPSW
C
CCCCC THE FOLLOWING 5 LINES WERE ADDED FEBRUARY 1993
      CHARACTER*24 CURRTI
      CHARACTER*24 CURRDA
      CHARACTER*4 IC4
      CHARACTER*4 IFOUNN
      CHARACTER*4 IERRON
C
CCCCC THE FOLLOWING LINE NOVEMBER 1994
      CHARACTER*4 NEWNAM
CCCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 1995
      CHARACTER*4 ICOMHO
      CHARACTER*4 ICOMH2
CCCCC THE FOLLOWING 2 LINES WERE ADDED OCTOBER 1996
      CHARACTER*4 IRHSTG
CCCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 2003
      CHARACTER*4 ITABBR
      CHARACTER*80 ITABTI
C
      CHARACTER*4 ICASOD
C
      CHARACTER*4 IFUTMP(100)
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      DIMENSION IDEFHL(10)
      DIMENSION IHOSLI(10)
C
CCCCC DIMENSION IANSSV(50,80)
      DIMENSION IANSSV(MAXLIS,MAXCIS)
C
      DIMENSION ICOM3(*)
      DIMENSION ICOM4(*)
      DIMENSION ICOM5(*)
      DIMENSION NCOM5(*)
C
      DIMENSION ICTRA1(*)
      DIMENSION NCTRA1(*)
      DIMENSION ICTRA2(*)
      DIMENSION NCTRA2(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCODG.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOGR.INC'
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
      INCLUDE 'DPCODE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGSU.EQ.'OFF'.OR.ISUBRO.EQ.'INSU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MAINSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGSU,IBUGS2
   53 FORMAT('IBUGSU,IBUGS2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IBUGCO,IBUGEV,IBUGQ
   55 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)ISQUAR,IBOOSS,IDEBOO
   58 FORMAT('ISQUAR,IBOOSS,IDEBOO = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IMACRO,IMACNU,IMACCS,IOFILE
   59 FORMAT('IMACRO,IMACNU,IMACCS,IOFILE = ',A4,I8,2X,A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,60)ICRENU,ICREST
CCC60 FORMAT('ICRENU,ICREST = ',I8,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IFENSW
   61 FORMAT('IFENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IFOUND,IERROR
   62 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ICOM,ICOM2
   63 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)NUMARG
   68 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO70I=1,NUMARG
      WRITE(ICOUT,71)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
   71 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   70 CONTINUE
      WRITE(ICOUT,72)NUMCHA
   72 FORMAT('NUMCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)(IA(I),I=1,100)
   73 FORMAT('(IA(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IMACRO,IPROGR,ICONCL
   75 FORMAT('IMACRO,IPROGR,ICONCL = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,76)IPRONU,ICONNU
CCC76 FORMAT('IPRONU,ICONNU = ',2I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ITOPIC
   77 FORMAT('ITOPIC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)MAXNXT
   78 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)ISACNC
   81 FORMAT('ISACNC = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IAUTSW,IAUTEX
   82 FORMAT('IAUTSW,IAUTEX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IHELMX,IFTEXP
   83 FORMAT('IHELMX,IFTEXP = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IFORSW
   84 FORMAT('IFORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)ALOWFR
   85 FORMAT('ALOWFR = ',E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,86)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
   86 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IPRITY,IOUTTY
   87 FORMAT('IPRITY,IOUTTY = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)ALOWDG
   88 FORMAT('ALOWDG = ',E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
C               ******************************
C               **  TREAT THE ADD     CASE  **
C               **  TREAT THE CALL    CASE  **
C               **  TREAT THE EXECUTE CASE  **
C               **  TREAT THE RUN     CASE  **
C               ******************************
C
      IF(ICOM.EQ.'ADD')GOTO100
      IF(ICOM.EQ.'CALL')GOTO100
      IF(ICOM.EQ.'EXEC')GOTO100
      GOTO199
C
  100 CONTINUE
      CALL DPMACR(ICOM,ICOM2,
CCCCC THE FOLOWING LINE WAS AUGMENTED   AUGUST 1994
CCCCC1IMACRO,IMACNU,IMACCS,
     1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IWIDTH,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IOFILE,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  199 CONTINUE
C
C               ******************************
C               **  TREAT THE DEFINE  CASE  **
C               ******************************
C
      IF(ICOM.EQ.'DEFI')GOTO200
      GOTO299
C
  200 CONTINUE
      CALL DPDEFI(IHARG,IHARG2,IHARLC,IHARL2,NUMARG,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
     1ICPREP,NCPREP,ICPOST,NCPOST,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  299 CONTINUE
C
C               ********************************
C               **  TREAT THE TRANSLATE CASE  **
C               ********************************
C
      IF(ICOM.EQ.'TRAN')GOTO300
      GOTO399
C
  300 CONTINUE
      CALL DPTRAN(IHARG,IHARG2,NUMARG,
     1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  399 CONTINUE
C
C               ***************************
C               **  TREAT THE BAUD CASE  **
C               ***************************
C
      IF(ICOM.EQ.'BAUD')GOTO400
      GOTO499
C
  400 CONTINUE
      CALL DPBAUD(IHARG,IARGT,IARG,NUMARG,IDEFBA,
     1IBAUD,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')GOTO410
      GOTO419
  410 CONTINUE
      IGBAUD=IBAUD
      DO415I=1,MAXDEV
      IDBAUD(I)=IBAUD
  415 CONTINUE
  419 CONTINUE
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  499 CONTINUE
C
C               ************************************
C               **  TREAT THE COLUMN LIMITS CASE  **
C               ************************************
C
CCCCC IF(ICOM.EQ.'COLU')GOTO500
C  DECEMBER, 1989.  CHECK FOR CONFLICT WWITH COLUMN RULER COMMAND.
      IF(ICOM.EQ.'COLU'.AND.IHARG(1).NE.'RULE')GOTO500
      GOTO599
C
  500 CONTINUE
      CALL DPCOLL(IDEFC1,IDEFC2,IFCOL1,IFCOL2,
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE
     1NUMRCM,
     1IFCOLL,IFCOLU,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  599 CONTINUE
C
C               ********************************************
C               **  TREAT THE MAXIMUM RECORD LENGTH CASE  **
C               ********************************************
C
      IF(ICOM.EQ.'MAXI'.AND.IHARG(1).EQ.'RECO'.AND.IHARG(2).EQ.'LENG')
     1  THEN
        CALL DPMXRL(IHARG,IARGT,IARG,NUMARG,IDEFRL,NUMRCM,MAXRCL,
     1              IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C               ******************************
C               **  TREAT THE DEGREES CASE  **
C               ******************************
C
C     (THE FOLLOWING IS COMMENTED OUT
C     (THE FOLLOWING IS COMMENTED OUT
C     (THE FOLLOWING IS COMMENTED OUT
C     IN THE SUBROUTINE MAINDG)
C
CCCCC IF(ICOM.EQ.'DEGR'.AND.ICOM2.EQ.'EES ')GOTO700
CCCCC GOTO799
C
CC700 CONTINUE
CCCCC CALL DPDEGS(IHARG,NUMARG,IDEFAU,
CCCCC1IANGLU,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
CC799 CONTINUE
C
C               *****************************
C               **  TREAT THE DELETE CASE  **
C               *****************************
C
      IF(ICOM.EQ.'DELE')GOTO800
      GOTO899
C
  800 CONTINUE 
CCCCC THE FOLLOWING LINE WAS FIXED     SEPTEMBER 1995
CCCCC CALL DPDELE(IBUGS2,IBUGQ,IFOUND,IERROR)
      CALL DPDELE(IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
  899 CONTINUE
C
C               *********************************************
C               **  TREAT THE DEMODULATION FREQUENCY CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'DEMO')GOTO1000
      GOTO1099
C
 1000 CONTINUE
      CALL DPDEFR(IHARG,IARGT,ARG,NUMARG,DEFDMF,
     1DEMOFR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1099 CONTINUE
C
C               **********************************
C               **  TREAT THE DIMENSION CASE    **
C               **  TREAT THE REDIMENSION CASE  **
C               **********************************
C
      IF(ICOM.EQ.'DIME')GOTO1100
      IF(ICOM.EQ.'REDI')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      CALL DPDIME(IHARG,IARGT,IARG,NUMARG,IDEMXN,IDEMXC,
     1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM,
     1V,MAXNK,NUMN,MAXN,MAXNXT,
CCCCC JANUARY 1998.  ADD FOLLOWING LINE
     1MAXTOM,MAXROM,MAXCOM,MAXOBV,
     1NUMCOL,MAXCOL,IFOUND,IERROR,IBUGS2)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1199 CONTINUE
C
C               ***************************************
C               **  TREAT THE DOUBLE PRECISION CASE  **
C               ***************************************
C
      IF(ICOM.EQ.'DOUB')GOTO1200
      GOTO1299
C
 1200 CONTINUE
CCCCC CHECK FOR CONFLICT WITH DOUBLY NON-CENTRAL F PROB PLOT.
CCCCC SEPTEMBER 1994
CCCCC CHECK FOR CONFLICT WITH DOUBLE EXPONENTIAL PROB PLOT.
CCCCC OCTOBER 1995
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'NONC')GOTO9000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'NON-')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'WEIB')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'EXPO')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'GAMM')GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAMP')GOTO9000
      CALL DPDOUB(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1299 CONTINUE
C
C               ***************************
C               **  TREAT THE ECHO CASE  **
C               ***************************
C
      IF(ICOM.EQ.'ECHO')GOTO1300
      GOTO1399
C
 1300 CONTINUE
      CALL DPECSW(IHARG,NUMARG,
     1IECHO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1399 CONTINUE
C
C               ****************************
C               **  TREAT THE EXIT  CASE  **
C               **  TREAT THE END   CASE  **
C               **  TREAT THE HALT  CASE  **
C               **  TREAT THE STOP  CASE  **
C               ****************************
C
      IF(ICOM.EQ.'EXIT')GOTO1400
      IF(ICOM.EQ.'END '.AND.NUMARG.LE.0)GOTO1400
      IF(ICOM.EQ.'HALT')GOTO1400
      IF(ICOM.EQ.'STOP')GOTO1400
      IF(ICOM.EQ.'BYE ')GOTO1400
      IF(ICOM.EQ.'QUIT')GOTO1400
      GOTO1499
C
 1400 CONTINUE
      CALL DPEXIT(IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1499 CONTINUE
C
C               **********************************
C               **  TREAT THE ERASE DELAY CASE  **
C               **********************************
C
      IF(ICOM.EQ.'ERAS')GOTO1600
      GOTO1699
C
 1600 CONTINUE
      CALL DPERDE(IHARG,IARGT,ARG,NUMARG,DEFERD,
     1ERASDE,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')AGERDE=ERASDE
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1699 CONTINUE
C
C               **************************************
C               **  TREAT THE FIT CONSTRAINT  CASE  **
C               **************************************
C
      IF(ICOM.EQ.'FIT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'CONS')GOTO1700
      GOTO1799
C
 1700 CONTINUE
      CALL DPFICN(ICOM,IHARG,IHARG2,IARGT,ARG,NUMARG,
     1IPARNC,IPANC2,IPAROP,PARLIM,NUMCON,MAXCON,IFOUND,IERROR,IBUGS2)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1799 CONTINUE
C
C               *************************************
C               **  TREAT THE FIT ITERATIONS CASE  **
C               *************************************
C
      IF(ICOM.EQ.'FIT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'ITER')GOTO1800
      GOTO1899
C
 1800 CONTINUE
      CALL DPFIIT(IHARG,IARGT,IARG,NUMARG,IDEFNI,
     1IFITIT,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1899 CONTINUE
C
C               ********************************
C               **  TREAT THE FIT POWER CASE  **
C               ********************************
C
      IF(ICOM.EQ.'FIT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'POWE')GOTO1900
      GOTO1999
C
 1900 CONTINUE
      CALL DPFIPW(IHARG,IARGT,ARG,NUMARG,DEFFPW,
     1FITPOW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 1999 CONTINUE
C
C               *********************************************
C               **  TREAT THE FIT STANDARD DEVIATION CASE  **
C               *********************************************
C
      IF(ICOM.EQ.'FIT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'STAN')GOTO2000
      GOTO2099
C
 2000 CONTINUE
      CALL DPFISD(IHARG,IARGT,ARG,NUMARG,DEFFSD,
     1FITSD,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2099 CONTINUE
C
C               ****************************
C               **  TREAT THE GRADS CASE  **
C               ****************************
C
C     (THE FOLLOWING IS COMMENTED OUT
C     BECAUSE THE ANGLE COMMAND IS NOW DONE
C     IN THE SUBROUTINE MAINDG)
C
CCCCC IF(ICOM.EQ.'GRAD')GOTO2100
CCCCC GOTO2199
C
C2100 CONTINUE
CCCCC CALL DPGRAD(IHARG,NUMARG,IDEFAU,
CCCCC1IANGLU,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C2199 CONTINUE
C
C               **************************************
C               **  TREAT THE HARDCOPY DELAY CASE   **
C               **************************************
C
      IF(ICOM.EQ.'HARD')GOTO2200
      GOTO2299
C
 2200 CONTINUE
      CALL DPHADE(IHARG,IARGT,ARG,NUMARG,DEFHAD,
     1HARDDE,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')AGCODE=HARDDE
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2299 CONTINUE
C
C               ***************************
C               **  TREAT THE HELP CASE  **
C               ***************************
C
      IF(ICOM.EQ.'HELP')GOTO2300
      GOTO2399
C
 2300 CONTINUE
CCCCC THE FOLLOWING CALL WAS CHANGED JULY 1990
CCCCC CALL DPHELP(IHARG,IHARG2,NUMARG,IANS,IWIDTH,
CCCCC1IHELMX,
CCCCC1ICPREH,NCPREH,ICPOSH,NCPOSH,
CCCCC1IBUGS2,ISUBRO,IFOUND,IERROR)
C
CCCCC THE FOLLOWING CALL WAS INSERTED JULY 1990
CCCCC AND THEN COMMENTED OUT NOVEMBER 1991
CCCCC CALL DPHELP(IHARG,IHARG2,NUMARG,IANS,IWIDTH,
CCCCC1IHE1CO,IHE1AL,
CCCCC1IHE2CO,IHE2AL,
CCCCC1IHE3CO,IHE3AL,
CCCCC1IHE4CO,IHE4AL,
CCCCC1IHE5CO,IHE5AL,
CCCCC1IHE6CO,IHE6AL,
CCCCC1IHE7CO,IHE7AL,
CCCCC1IHE8CO,IHE8AL,
CCCCC1IHE9CO,IHE9AL,
CCCCC1IHELMX,
CCCCC1ICPREH,NCPREH,ICPOSH,NCPOSH,
CCCCC1IBUGS2,ISUBRO,IFOUND,IERROR)
C
CCCCC THE FOLLOWING CALL WAS CHANGED BACK NOVEMBER 1991
      CALL DPHELP(IHARG,IHARG2,NUMARG,IANS,IWIDTH,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2399 CONTINUE
C
C               ***************************
C               **  TREAT THE HOST CASE  **
C               ***************************
C
      IF(ICOM.EQ.'HOST'.AND.NUMARG.LE.0)GOTO2400
      IF(ICOM.EQ.'HOST'.AND.NUMARG.GE.1.AND.
     1IHARG(1).NE.'LINK')GOTO2400
      GOTO2499
C
 2400 CONTINUE
      CALL DPHOST(IHARG,NUMARG,IDEFHO,
     1IHOST,IHOST1,IHOST2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2499 CONTINUE
C
C               ********************************
C               **  TREAT THE HOST LINK CASE  **
C               ********************************
C
      IF(ICOM.EQ.'HOST'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LINK')GOTO2500
      IF(ICOM.EQ.'COMM'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LINK')GOTO2500
      IF(ICOM.EQ.'LINK')GOTO2500
      GOTO2599
C
 2500 CONTINUE
      IF(IHARG(1).EQ.'LINK')GOTO2510
      ISHIFT=1
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGS2,IERROR)
      IHARG(1)='LINK'
      IHARG2(1)='    '
 2510 CONTINUE
      CALL DPHOSL(IHARG,NUMARG,IDEFHL,
     1IHOSLI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2599 CONTINUE
C
C               ****************************
C               **  TREAT THE KNOTS CASE  **
C               ****************************
C
      IF(ICOM.EQ.'KNOT')GOTO2600
      GOTO2699
C
 2600 CONTINUE
      CALL DPKNOT(IHARG,IHARG2,NUMARG,IDEFK1,IDEFK2,
     1IKNOT1,IKNOT2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2699 CONTINUE
C
C               ************************************
C               **  TREAT THE MACRO CASE          **
C               **  TREAT THE END MACRO CASE      **
C               **  TREAT THE END OF MACRO CASE   **
C               **  TREAT THE CREATE CASE         **
C               **  TREAT THE END CREATE CASE     **
C               **  TREAT THE END OF CREATE CASE  **
C               ************************************
C
      IF(ICOM.EQ.'MACR')GOTO2700
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'MACR')GOTO2700
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MACR')GOTO2700
      IF(ICOM.EQ.'CREA')GOTO2700
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CREA')GOTO2700
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'CREA')GOTO2700
      GOTO2799
C
 2700 CONTINUE
      CALL DPMACR(ICOM,ICOM2,
CCCCC THE FOLOWING LINE WAS AUGMENTED   AUGUST 1994
CCCCC1IMACRO,IMACNU,IMACCS,
     1IMACRO,IMACNU,IMACCS,IMACL1,IMACL2,IMACLR,IMALEV,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IWIDTH,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IOFILE,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2799 CONTINUE
C
C               *******************************
C               **  TREAT THE OPERATOR CASE  **
C               **  TREAT THE CONSOLE  CASE  **
C               *******************************
C
      IF(ICOM.EQ.'CONS'.AND.ICOM2.EQ.'OLE ')GOTO2900
      IF(ICOM.EQ.'OPER')GOTO2900
      GOTO2999
C
 2900 CONTINUE
      CALL DPOPMS(IANSLC,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 2999 CONTINUE
C
C               ***************************
C               **  TREAT THE NAME CASE  **
C               ***************************
C
      IF(ICOM.EQ.'NAME')GOTO3000
      IF(ICOM.EQ.'RENA')GOTO3000
      GOTO3019
C
 3000 CONTINUE
      CALL DPNAME(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IVARLB,
     1NUMCOL,MAXCOL,MAXN,IANS,IWIDTH,IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3019 CONTINUE
C
C               *************************************
C               **  TREAT THE VARIABLE LABEL CASE  **
C               **  NAME CONFLICTS WITH "VARIANCE" **
C               **  COMMANDS.                      **
C               *************************************
C
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'ABLE')GOTO3020
      GOTO3029
C
 3020 CONTINUE
      CALL DPVLAB(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVSTAR,IVSTOP,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IVARLB,
     1NUMCOL,MAXCOL,MAXN,IANS,IANSLC,IWIDTH,IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3029 CONTINUE
C
C               ****************************************
C               **  TREAT THE POLYNOMIAL DEGREE CASE  **
C               **  TREAT THE DEGREE CASE             **
C               ****************************************
C
      IF(ICOM.EQ.'DEGR'.AND.ICOM2.EQ.'EE  ')GOTO3100
      IF(ICOM.EQ.'POLY')GOTO3100
      GOTO3199
C
 3100 CONTINUE
      IF(NUMARG.GE.2. AND. IHARG(1).EQ.'MLE')GOTO3199
      IF(NUMARG.GE.3. AND. IHARG(1).EQ.'MAXI' .AND.
     1   IHARG(2).EQ.'LIKE')GOTO3199
      CALL DPDEGR(IHARG,IARGT,IARG,NUMARG,IDEFDG,
     1IDEG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3199 CONTINUE
C
C               ********************************
C               **  TREAT THE PRECISION CASE  **
C               ********************************
C
      IF(ICOM.EQ.'PREC')GOTO3200
      GOTO3299
C
 3200 CONTINUE
      CALL DPPREC(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3299 CONTINUE
C
C               ********************************
C               **  TREAT THE PRE-ERASE CASE  **
C               ********************************
C
      IF(ICOM.EQ.'PRE')GOTO3300
      GOTO3399
C
 3300 CONTINUE
      CALL DPPREE(IHARG,NUMARG,
     1IERASW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3399 CONTINUE
C
C               *******************************
C               **  TREAT THE PRINTING CASE  **
C               *******************************
C
      IF(ICOM.EQ.'PRIN'.AND.ICOM2.EQ.'TING')GOTO3400
      GOTO3499
C
 3400 CONTINUE
      CALL DPPRSW(IHARG,NUMARG,
     1IPRIN2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3499 CONTINUE
C
C               ****************************
C               **  TREAT THE PROBE CASE  **
C               ****************************
C
      IF(ICOM.EQ.'PROB')GOTO3500
      IF(ICOM.EQ.'DUMP')GOTO3500
      IF(ICOM.EQ.'SHOW')GOTO3500
      GOTO3599
C
 3500 CONTINUE
      CALL DPPROB(ILISMX,IREPCH,IOSW,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO,
CCCCC AUGUST 1995.  ADD IFTORD
CCCCC1IHELMX,IFTEXP,
     1IHELMX,IFTEXP,IFTORD,
     1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF,
     1IREARW,IWRIRW,
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
     1NPLOTP,
CCCCC THE FOLLOWING LINE WAS ADDED   FEBRUARY 1993
     1IPRITY,
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1995
     1IUNFOF,IUNFNR,IUNFMC,
CCCCC FOLLOWING LINE ADD MARCH 1996
CCCCC1IRHSTG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3599 CONTINUE
C
C               ******************************************
C               **  TREAT THE QUADRUPLE PRECISION CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'QUAD'.AND.ICOM2.EQ.'RUPL')GOTO3600
      GOTO3699
C
 3600 CONTINUE
      CALL DPQUAD(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3699 CONTINUE
C
C               ******************************
C               **  TREAT THE RADIANS CASE  **
C               ******************************
C
C     (THE FOLLOWING IS COMMENTED OUT
C     BECAUSE THE ANGLE COMMAND IS NOW DONE
C     IN THE SUBROUTINE MAINDG)
C
CCCCC IF(ICOM.EQ.'RADI')GOTO3700
CCCCC GOTO3799
C
C3700 CONTINUE
CCCCC CALL DPRADI(IHARG,NUMARG,IDEFAU,
CCCCC1IANGLU,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C3799 CONTINUE
C
C               ***************************
C               **  TREAT THE READ CASE  **
C               ***************************
C
      IF(ICOM.EQ.'READ')GOTO3800
      GOTO3899
C
 3800 CONTINUE
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FORM'.AND.
CCCCC1IHARG2(1).EQ.'AT')GOTO3899
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REWI'.AND.
CCCCC1IHARG2(1).EQ.'ND')GOTO3899
C
CCCCC MAY, 1990.  ADD ICOMCH, ICOMSW TO CALL LIST
CCCCC MARCH, 1996.  ADD IMALEV TO CALL LIST
      INTINF=I1MACH(9)
      CALL DPREAD(IFROW1,IFROW2,IFCOL1,IFCOL2,ISKIP,INTINF,
     1IMACRO,IMACNU,IMACCS,IMALEV,IOSW,ICREAF,NCREAF,
     1IREARW,
     1ICOMCH,ICOMSW,
CCCCC APRIL 1995.  ADD FOLLOWING LINE
     1IUNFOF,IUNFNR,IUNFMC,
CCCCC FEBRAURY 2003.  ADD FOLLOWING LINE
     1NUMRCM,
     1IFCOLL,IFCOLU,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO3899
C
 3899 CONTINUE
C
C               ****************************
C               **  TREAT THE RESET CASE  **
C               ****************************
C
      IF(ICOM.EQ.'RESE')GOTO3900
      IF(ICOM.EQ.'CLEA')GOTO3900
      GOTO3999
C
 3900 CONTINUE
      IF(ICOM.EQ.'CLEA')GOTO3910
      GOTO3919
 3910 CONTINUE
      ICOM='RESE'
      ICOM2='T   '
 3919 CONTINUE
      CALL DPRESE(IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 3999 CONTINUE
C
C               ******************************
C               **  TREAT THE RESTORE CASE  **
C               ******************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REST'.AND.
     1IHARG(1).EQ.'MEMO'.AND.IHARG2(1).EQ.'RY  ')GOTO4000
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REST'.AND.
     1IHARG(1).EQ.'ALL '.AND.IHARG2(1).EQ.'    ')GOTO4000
      IF(ICOM.EQ.'REST')GOTO4000
      GOTO4099
C
 4000 CONTINUE
      CALL DPREST(IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4099 CONTINUE
C
C               *****************************
C               **  TREAT THE RETAIN CASE  **
C               **  TREAT THE KEEP   CASE  **
C               **  TREAT THE PACK   CASE  **
C               *****************************
C
      IF(ICOM.EQ.'RETA')GOTO4100
      IF(ICOM.EQ.'KEEP')GOTO4100
      IF(ICOM.EQ.'PACK')GOTO4100
      GOTO4199
C
 4100 CONTINUE
      CALL DPRETA(IBUGS2,IBUGQ,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4199 CONTINUE
C
C               *********************************
C               **  TREAT THE ROW LIMITS CASE  **
C               *********************************
C
      IF(ICOM.EQ.'ROW')GOTO4200
      GOTO4299
C
 4200 CONTINUE
      CALL DPROWL(IHARG,IARGT,IARG,NUMARG,IDEFR1,IDEFR2,
     1IFROW1,IFROW2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4299 CONTINUE
C
C               ******************************************
C               **  TREAT THE TERMINATOR CHARACTOR CASE **
C               **  TREAT THE SEPARATOR CHARACTOR CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'TERM'.AND.ICOM2.EQ.'INAT')GOTO4300
      IF(ICOM.EQ.'SEPA'.AND.ICOM2.EQ.'RATO')GOTO4300
      GOTO4399
C
 4300 CONTINUE
      CALL DPTECH(IHARG,NUMARG,
     1IDEFTC,
     1ITERCH,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4399 CONTINUE
C
C               ******************************************
C               **  TREAT THE CONTINUE   CHARACTOR CASE **
C               ******************************************
C
      IF(ICOM.EQ.'CONT'.AND.ICOM2.EQ.'INUE')GOTO4400
      GOTO4499
C
 4400 CONTINUE
      CALL DPCONC(IHARG,NUMARG,
     1IDEFCC,
     1ICONCH,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4499 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1989
C               ********************************************
C               **  TREAT THE REPLACEMENT  CHARACTOR CASE **
C               **  TREAT THE SUBSTITUTION CHARACTOR CASE **
C               ********************************************
C
      IF(ICOM.EQ.'REPL'.AND.ICOM2.EQ.'ACEM')GOTO4500
      IF(ICOM.EQ.'SUBS'.AND.ICOM2.EQ.'TITU')GOTO4500
      GOTO4599
C
 4500 CONTINUE
      CALL DPRECH(IHARG,NUMARG,
     1IBASLC,
     1IREPCH,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4599 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED SEPTEMBER 2005
C               **************************************************
C               **  TREAT THE MACRO SUBSTITUTION CHARACTOR CASE **
C               **************************************************
C
      IF(ICOM.EQ.'MACR'.AND.IHARG(1).EQ.'SUBS'.AND.
     1   IHARG(2).EQ.'CHAR')THEN
        CALL DPREMA(IHARG,NUMARG,
     1              IBASLC,
     1              IMACSC,IDEFMS,
     1              IBUGS2,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C               **********************************
C               **  TREAT THE SERIAL READ CASE  **
C               **********************************
C
      IF(ICOM.EQ.'SERI')GOTO4600
      GOTO4699
C
CCCCC MAY, 1990.  ADD ICOMCH, ICOMSW TO CALL LIST
CCCCC MARCH, 1996.  ADD IMALEV TO CALL LIST
 4600 CONTINUE
      INTINF=I1MACH(9)
      CALL DPSERI(IFROW1,IFROW2,IFCOL1,IFCOL2,ISKIP,INTINF,
     1IMACRO,IMACNU,IMACCS,IOSW,IMALEV,
     1IREARW,
     1ICOMCH,ICOMSW,
CCCCC FEBRAURY 2003.  ADD FOLLOWING LINE
     1NUMRCM,
     1IFCOLL,IFCOLU,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4699 CONTINUE
C
C               ***************************************
C               **  TREAT THE SINGLE PRECISION CASE  **
C               ***************************************
C
      IF(ICOM.EQ.'SING')GOTO4700
      GOTO4799
C
 4700 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SAMP')GOTO4799
      CALL DPSING(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4799 CONTINUE
C
C               ***************************
C               **  TREAT THE SKIP CASE  **
C               ***************************
C
      IF(ICOM.EQ.'SKIP')GOTO4800
      GOTO4899
C
 4800 CONTINUE
      CALL DPSKIP(IHARG,IARGT,IARG,NUMARG,IDEFSK,
     1ISKIP,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4899 CONTINUE
C
C               *****************************
C               **  TREAT THE STATUS CASE  **
C               *****************************
C
CCCCC NOVEMBER 1997.  GUI STATUS (DON'T STORE IN SAVED COMMAND
CCCCC LIST)
      IF(ICOM.EQ.'GUI ')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'STAT')THEN
             ISHIFT=1
             CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                   IBUGA2,IERROR)
             ICOM='STAT'
             ICOM2='US  '
        ENDIF
      ENDIF
      IF(ICOM.EQ.'WRIT')GOTO5800
      IF(ICOM.EQ.'STAT')GOTO4900
      GOTO4999
C
 4900 CONTINUE
      CALL DPSTAT(
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 4999 CONTINUE
C
C               **************************************
C               **  TREAT THE SUBSET MESSAGES CASE  **
C               **************************************
C
CCCCC IF(ICOM.EQ.'SUBS')GOTO5000
CCCCC GOTO5099
C
C5000 CONTINUE
CCCCC CALL DPSMSW(IHARG,NUMARG,
CCCCC1ISUBMS,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C5099 CONTINUE
C
C               ****************************
C               **  TREAT THE TIME  CASE  **
C               **  TREAT THE CLOCK CASE  **
C               ****************************
C
      IF(ICOM.EQ.'TIME')GOTO5100
      IF(ICOM.EQ.'CLOC')GOTO5100
CCCCC THE FOLLOWING LINE WAS ADDED SEPTEMBER 1990
      IF(ICOM.EQ.'DATE')GOTO5100
      GOTO5199
C
 5100 CONTINUE
CCCCC THE FOLLOWING SECTION WAS CHANGED FEBRUARY 1993
CCCCC CALL DPTIME(IBUGS2,ISUBRO,IFOUND,IERROR)
      CALL DPTIME(CURRTI,NCURRT,CURRDA,NCURRD,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')THEN
         DO5110I=1,NCURRT
            IC4(1:4)='    '
            IC4(1:1)=CURRTI(I:I)
            IFUTMP(I)=IC4(1:4)
5110     CONTINUE
         CALL UPDATF('CURR','TIME',IFUTMP,NCURRT,'CHAD','NO  ',
     1   IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1   NUMNAM,MAXNAM,IANS,IWIDTH,ILISTL,NEWNAM,MAXN3,
     1   IFUNC,NUMCHF,MAXCHF,IBUGS2,ILOCN,IFOUNN,IERRON)
         DO5120I=1,NCURRD
            IC4(1:4)='    '
            IC4(1:1)=CURRDA(I:I)
            IFUTMP(I)=IC4(1:4)
5120     CONTINUE
         CALL UPDATF('CURR','DATE',IFUTMP,NCURRD,'CHAD','NO  ',
     1   IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1   NUMNAM,MAXNAM,IANS,IWIDTH,ILISTL,NEWNAM,MAXN3,
     1   IFUNC,NUMCHF,MAXCHF,IBUGS2,ILOCN,IFOUNN,IERRON)
      ENDIF
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5199 CONTINUE
C
C               **********************************
C               **  TREAT THE PROCESS-ID  CASE  **
C               **********************************
C
      IFOUND='NO'
      IF(ICOM.EQ.'PID ' .OR.
     1   (ICOM.EQ.'PROC' .AND. IHARG(1).EQ.'ID'))THEN
        CALL DPPID(IPID,IBUGS2,ISUBRO,IFOUND,IERROR)
    
        IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO'.AND.IPID.GT.0)THEN
          IH='PID '
          IH2='    '
          VALUE0=REAL(IPID)
          CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1                IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1                IANS,IWIDTH,IBUGS2,IERROR)
        ENDIF
      ENDIF
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  TREAT THE TRIPLE PRECISION CASE  **
C               ***************************************
C
      IF(ICOM.EQ.'TRIP')GOTO5200
      GOTO5299
C
 5200 CONTINUE
      CALL DPTRIP(IHARG,NUMARG,IDEFPR,IHMXPR,
     1IPREC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5299 CONTINUE
C
C               ******************************
C               **  TREAT THE WEIGHTS CASE  **
C               ******************************
C
      IF(ICOM.EQ.'WEIG')GOTO5400
      GOTO5499
C
 5400 CONTINUE
      CALL DPWEIG(IHARG,IHARG2,NUMARG,IDEFW1,IDEFW2,
     1IWEIG1,IWEIG2,IWEIGH,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5499 CONTINUE
C
C               ************************************************
C               **  TREAT THE ORTHOGONAL DISTANCE ERROR CASE  **
C               ************************************************
C
      IF(ICOM.EQ.'ORTH')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIST'.AND.IHARG(2).EQ.'ERRO')
     1    THEN
          ISHIFT=2
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPORER(IHARG,IHARG2,NUMARG,
     1                IODRE1,IODRE2,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               ************************************************
C               **  TREAT THE ORTHOGONAL DISTANCE DELTA CASE  **
C               ************************************************
C
      IF(ICOM.EQ.'ORTH')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIST'.AND.IHARG(2).EQ.'DELT')
     1    THEN
          ICASOD='DELT'
          ISHIFT=2
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPORDE(IHARG,IHARG2,NUMARG,
     1                IODRD1,IODRD2,IODRD3,IODRD4,
     1                IWEIN1,IWEIN2,
     1                ICASOD,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
      IF(ICOM.EQ.'ORTH')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'DIST'.AND.IHARG(2).EQ.'Y   ')
     1    THEN
          ICASOD='Y   '
          ISHIFT=2
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPORDE(IHARG,IHARG2,NUMARG,
     1                IODRD1,IODRD2,IODRD3,IODRD4,
     1                IWEIN1,IWEIN2,
     1                ICASOD,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               **************************************
C               **  TREAT THE CLASS ... LOWER CASE  **
C               **************************************
C
      IF(ICOM.EQ.'CLAS')GOTO5500
      GOTO5599
C
 5500 CONTINUE
      CALL DPCLLO(IHARG,IARGT,ARG,NUMARG,
     1CLLIMI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5599 CONTINUE
C
C               **************************************
C               **  TREAT THE CLASS ... UPPER CASE  **
C               **************************************
C
      IF(ICOM.EQ.'CLAS')GOTO5600
      GOTO5699
C
 5600 CONTINUE
      CALL DPCLUP(IHARG,IARGT,ARG,NUMARG,
     1CLLIMI,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5699 CONTINUE
C
C               **************************************
C               **  TREAT THE CLASS ... WIDTH CASE  **
C               **************************************
C
      IF(ICOM.EQ.'CLAS')GOTO5700
      GOTO5799
C
 5700 CONTINUE
      CALL DPCLWI(IHARG,IARGT,ARG,NUMARG,
     1CLWIDT,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5799 CONTINUE
C
C               ****************************
C               **  TREAT THE WRITE CASE  **
C               **  TREAT THE PRINT CASE  **
C               ****************************
C
CCCCC NOVEMBER 1997.  GUI PRINT/WRITE (DON'T STORE IN SAVED COMMAND
CCCCC LIST)
      IF(ICOM.EQ.'GUI ')THEN
        IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PRIN'.OR.
     1     IHARG(1).EQ.'WRIT')THEN
             ISHIFT=1
             CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                   IBUGA2,IERROR)
             ICOM='WRIT'
             ICOM2='E   '
        ENDIF
      ENDIF
      IF(ICOM.EQ.'WRIT')GOTO5800
      IF(ICOM.EQ.'PRIN'.AND.ICOM2.EQ.'T   ')GOTO5800
      GOTO5899
C
 5800 CONTINUE
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI'.AND.
CCCCC1IHARG2(1).EQ.'MALS')GOTO5899
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI'.AND.
CCCCC1IHARG2(1).EQ.'MAL')GOTO5899
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FORM'.AND.
CCCCC1IHARG2(1).EQ.'AT')GOTO5899
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REWI'.AND.
CCCCC1IHARG2(1).EQ.'ND')GOTO5899
C
      CALL DPWRIT(
     1IMACRO,IMACNU,IMACCS,
     1IFORSW,ICWRIF,NCWRIF,
     1IWRIRW,
     1ITABTI,NCTABT,ITABBR,ITABSP,ITABWD,ITABHT,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5899 CONTINUE
C
C               ******************************
C               **  TREAT THE COMMENT CASE  **
C               **  TREAT THE    .    CASE  **
C               ******************************
C
C  MAY, 1990.  SOFT-CODE THE COMMENT CHARACTER.  ALSO, A COMMENT
C  CHARACTER AND A COMMENT CHECK COMMAND WERE ADDED.  ALWAYS TREAT
C  PERIOD AS COMMENT ON COMMAND LINE.
C
      IF(ICOM.EQ.'.')GOTO5900
CCCCC IF(ICOM.EQ.'COMM')GOTO5900
      IF(ICOM.EQ.ICOMCH)GOTO5900
      IF(ICOM.EQ.'COMM'.AND.
     1(IHARG(1).NE.'CHAR'.AND.IHARG(1).NE.'CHEC'))GOTO5900
      GOTO5999
C
 5900 CONTINUE
      CALL DPDOT(IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 5999 CONTINUE
C
C               *******************************
C               **  TREAT THE FEEDBACK CASE  **
C               *******************************
C
      IF(ICOM.EQ.'FEED')GOTO6100
      GOTO6199
C
 6100 CONTINUE
      CALL DPFEED(IHARG,NUMARG,
     1IFEED2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6199 CONTINUE
C
C               ***********************************
C               **  TREAT THE FILTER WIDTH CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'FILT')GOTO6200
      GOTO6299
C
 6200 CONTINUE
      CALL DPFIWI(IHARG,IARGT,ARG,NUMARG,DEFFW,
     1FILWID,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6299 CONTINUE
C
C               **************************************
C               **  TREAT THE DEFAULT COMMAND CASE  **
C               **************************************
C
      IF(ICOM.EQ.'DEFA')GOTO6300
      GOTO6399
C
 6300 CONTINUE
      CALL DPDECO(IANS,IWIDTH,IHARG,NUMARG,
     1IDEFCM,IWIDDC,IDEFC,IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6399 CONTINUE
C
C               ***************************
C               **  TREAT THE BUGS CASE  **
C               ***************************
C
      IF(ICOM.EQ.'BUGS')GOTO6600
      IF(ICOM.EQ.'BUG ')GOTO6600
      GOTO6699
C
 6600 CONTINUE
      CALL DPBUGS(IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6699 CONTINUE
C
C               ***************************
C               **  TREAT THE MAIL CASE  **
C               ***************************
C
      IF(ICOM.EQ.'MAIL')GOTO6700
      GOTO6799
C
 6700 CONTINUE
      CALL DPMAIL(IANSLC,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6799 CONTINUE
C
C               ***************************
C               **  TREAT THE NEWS CASE  **
C               ***************************
C
      IF(ICOM.EQ.'NEWS')GOTO6800
      GOTO6899
C
 6800 CONTINUE
      CALL DPNEWS(IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6899 CONTINUE
C
C               ****************************
C               **  TREAT THE QUERY CASE  **
C               ****************************
C
      IF(ICOM.EQ.'QUER')GOTO6900
      IF(ICOM.EQ.'QUES')GOTO6900
      IF(ICOM.EQ.'MESS')GOTO6900
      GOTO6999
C
 6900 CONTINUE
      CALL DPQUER(IANSLC,IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 6999 CONTINUE
C
C               ****************************
C               **  TREAT THE SET   CASE  **
C               ****************************
C
      IF(ICOM.EQ.'SET ')GOTO7110
C
CCCCC IF(ICOM.EQ.'READ')GOTO7105
CCCCC IF(ICOM.EQ.'WRIT')GOTO7105
CCCCC IF(ICOM.EQ.'PRIN'.AND.ICOM2.EQ.'T   ')GOTO7105
CCCCC GOTO7199
C
C7105 CONTINUE
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI'.AND.
CCCCC1IHARG2(1).EQ.'MALS')GOTO7110
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI'.AND.
CCCCC1IHARG2(1).EQ.'MAL')GOTO7110
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FORM'.AND.
CCCCC1IHARG2(1).EQ.'AT')GOTO7110
CCCCC IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REWI'.AND.
CCCCC1IHARG2(1).EQ.'ND')GOTO7110
      GOTO7199
C
 7110 CONTINUE
      CALL DPSET(ILISMX,IREPCH,IOSW,
     1IPPDE1,IPPDE2,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IBUGEX,IBUGE2,IBUGHE,IBUGH2,IBUGLO,
CCCCC AUGUST 1995.  ADD IFTORD
CCCCC1IHELMX,IFTEXP,
     1IHELMX,IFTEXP,IFTORD,
     1IFORSW,ICREAF,NCREAF,ICWRIF,NCWRIF,
     1IREARW,IWRIRW,
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
     1NPLOTP,
CCCCC THE FOLLOWING LINE WAS ADDED   FEBRUARY 1993
     1IPRITY,
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1995
     1IUNFOF,IUNFNR,IUNFMC,
CCCCC FOLLOWING LINE ADD MARCH 1996
CCCCC1IRHSTG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7199 CONTINUE
C
C               ********************************
C               **  TREAT THE IMPLEMENT CASE  **
C               ********************************
C
      IF(ICOM.EQ.'IMPL')GOTO7200
      GOTO7299
C
 7200 CONTINUE
      CALL DPIMPL(IHARG,IARGT,IARG,NUMARG,
     1IX2TSW,IY2TSW,IX2ZSW,IY2ZSW,NCY2LA,
     1ISQUAR,
     1PXMIN,PYMIN,PXMAX,PYMAX,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 7299 CONTINUE
C
C               *****************************
C               **  TREAT THE REWIND CASE  **
C               *****************************
C
CCCCC IF(ICOM.EQ.'REWI')GOTO7300
CCCCC GOTO7399
CCCCC
C7300 CONTINUE
CCCCC CALL DPREWI(IBUGS2,IBUGQ,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C7399 CONTINUE
C
C               ******************************
C               **  TREAT THE ENDFILE CASE  **
C               ******************************
C
CCCCC IF(ICOM.EQ.'ENDF')GOTO7400
CCCCC GOTO7499
CCCCC
C7400 CONTINUE
CCCCC CALL DPENDF(IBUGS2,IBUGQ,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C7499 CONTINUE
C
C               *****************************
C               **  TREAT THE RELEASE CASE **
C               *****************************
C
CCCCC IF(ICOM.EQ.'RELE')GOTO7500
CCCCC IF(ICOM.EQ.'CLOS')GOTO7500
CCCCC IF(ICOM.EQ.'FREE')GOTO7500
CCCCC GOTO7599
CCCCC
C7500 CONTINUE
CCCCC CALL DPREWI(IBUGS2,IBUGQ,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C7599 CONTINUE
C
C               ***************************
C               **  TREAT THE SEED CASE  **
C               ***************************
C
      IF(ICOM.EQ.'SEED')GOTO8000
      GOTO8099
C
 8000 CONTINUE
      CALL DPSEED(IHARG,IARGT,IARG,NUMARG,IDEFSE,
     1ISEED,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8099 CONTINUE
C
C               **************************************
C               **  TREAT THE THE PROPORTION LIMITS   CASE  **
C               **  = THE ANOP LIMITS     CASE  **
C               **************************************
C
      IF(ICOM.EQ.'PROP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LIMI'.AND.IHARG2(1).EQ.'TS  ')GOTO8100
      IF(ICOM.EQ.'PROP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'REGI'.AND.IHARG2(1).EQ.'ON  ')GOTO8100
      IF(ICOM.EQ.'ANOP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LIMI'.AND.IHARG2(1).EQ.'TS  ')GOTO8100
      IF(ICOM.EQ.'ANOP'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'REGI'.AND.IHARG2(1).EQ.'ON  ')GOTO8100
      GOTO8199
C
 8100 CONTINUE
      CALL DPANOL(IHARG,IARGT,ARG,NUMARG,DEFAL1,DEFAL2,
     1ANOPL1,ANOPL2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8199 CONTINUE
C
C               ****************************
C               **  TREAT THE FENCE CASE  **
C               ****************************
C
      IF(ICOM.EQ.'FENC')GOTO8200
      GOTO8299
C
 8200 CONTINUE
      CALL DPFENC(IHARG,NUMARG,
     1IFENSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8299 CONTINUE
C
C               ****************************
C               **  TREAT THE PAUSE CASE  **
C               ****************************
C
      IF(ICOM.EQ.'PAUS')GOTO8300
      IF(ICOM.EQ.'SLEE')GOTO8350
      GOTO8399
C
 8300 CONTINUE
      IF(NUMARG.GE.1)GOTO8350
      CALL DPPAUS(IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO8399
C
 8350 CONTINUE
      CALL DPSLEE(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8399 CONTINUE
C
C               ****************************
C               **  TREAT THE APPEND  CASE  **
C               ****************************
C
      IF(ICOM.EQ.'APPE')GOTO8400
      IF(ICOM.EQ.'AUGM')GOTO8400
      GOTO8499
C
 8400 CONTINUE
      CALL DPAPPE(IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8499 CONTINUE
C
C               ****************************
C               **  TREAT THE EXTEND  CASE  **
C               ****************************
C
      IF(ICOM.EQ.'EXTE')GOTO8500
      IF(ICOM.EQ.'AUGM')GOTO8500
      GOTO8599
C
 8500 CONTINUE
      CALL DPEXTE(IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8599 CONTINUE
C
C               **************************************
C               **  TREAT THE SUGGESTION  CASE      **
C               **  TREAT THE RECOMMENDATION  CASE  **
C               **  TREAT THE PROGRAM  CASE         **
C               **  TREAT THE CODE  CASE            **
C               **  TREAT THE EXPERT  CASE          **
C               **************************************
C
CCCCC IF(ICOM.EQ.'SUGG')GOTO8600
CCCCC IF(ICOM.EQ.'RECO')GOTO8600
CCCCC IF(ICOM.EQ.'PROG')GOTO8600
CCCCC IF(ICOM.EQ.'CODE')GOTO8600
CCCCC IF(ICOM.EQ.'EXPE')GOTO8600
CCCCC GOTO8699
CCCCC
C8600 CONTINUE
CCCCC CALL DPSUPR(IHARG,IHARG2,NUMARG,
CCCCC1ITOPIC,
CCCCC1IANS,IWIDTH,IBUGS2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C8699 CONTINUE
CCCCC
CCCCC           **************************************
CCCCC           **  TREAT THE GO          CASE      **
CCCCC           **************************************
CCCCC
CCCCC IF(ICOM.EQ.'GO')GOTO8700
CCCCC GOTO8799
CCCCC
C8700 CONTINUE
CCCCC CALL DPWRPF(IPRONU,IPROFS,IPROST,
CCCCC1ITOPIC,
CCCCC1IHARG,IHARG2,NUMARG,
CCCCC1IANS,IWIDTH,IBUGS2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C8799 CONTINUE
CCCCC
CCCCC           **************************************
CCCCC           **  TREAT THE CONCLUSIONS CASE      **
CCCCC           **************************************
CCCCC
CCCCC IF(ICOM.EQ.'CONC')GOTO8800
CCCCC GOTO8899
CCCCC
C8800 CONTINUE
CCCCC CALL DPLICF(ICONNU,ICONFS,ICONST,
CCCCC1IANS,IWIDTH,IBUGS2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C8899 CONTINUE
CCCCC
CCCCC
C               **************************************
C               **  TREAT THE ROOT ACCURACY  CASE   **
C               **************************************
C
      IF(ICOM.EQ.'ROOT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'ACCU')GOTO8900
      GOTO8999
C
 8900 CONTINUE
C
      CALL DPROAC(IHARG,IARGT,ARG,NUMARG,DEFRAC,
     1ROOTAC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 8999 CONTINUE
C
CCCCC           ***************************
CCCCC           **  TREAT THE MENU CASE  **
CCCCC           ***************************
CCCCC
CCCCC IF(ICOM.EQ.'MENU')GOTO9100
CCCCC GOTO9199
CCCCC
C9100 CONTINUE
CCCCC CALL DPMENU(IMENNU,IMENFS,IMENST,
CCCCC1IHARG,NUMARG,IANS,IWIDTH,IBUGS2,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
CCCCC
C9199 CONTINUE
CCCCC
C               *****************************
C               **  TREAT THE PROMPT CASE  **
C               *****************************
C
      IF(ICOM.EQ.'PROM')GOTO9200
      GOTO9299
C
 9200 CONTINUE
      CALL DPPROM(IHARG,NUMARG,IPROSW,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
 9299 CONTINUE
C
C               **************************************
C               **  TREAT THE LIST (COMMANDS) CASE  **
C               **  (SAME AS THE RECALL CASE)       **
C               **************************************
C
CCCCC THE FOLLOWING PARAGRAPH WAS REWRITTEN    SEPTEMBER 1993
C
      IF(NUMARG.LE.0)THEN
         IF(ICOM.EQ.'LIST')GOTO9300
         IF(ICOM.EQ.'TYPE')GOTO9300
         IF(ICOM.EQ.'L')GOTO9300
         IF(ICOM.EQ.'RECA')GOTO9300
CCCC THE FOLLOWING 3 LINES WERE ADDED SEPTEMBER 1992
         IF(ICOM.EQ.'VIEW')GOTO9300
         IF(ICOM.EQ.'V')GOTO9300
         IF(ICOM.EQ.'PREV')GOTO9300
      ENDIF
      GOTO9399
C
 9300 CONTINUE
      CALL DPLICO(IHARG,NUMARG,IANSSV,IREPMX,ILISMX,IPOINT,
CCCCC THE FOLLOWING 2 LINES WERE ADDED   JULY 1993
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9399
C
 9399 CONTINUE
C
C               ****************************
C               **  TREAT THE LIST  CASE  **
C               ****************************
C
CCCCC CHECK FOR CONFLICT WITH LIST GRAPH AND LIST PLOT  APRIL 1997
CCCC CHECK FOR NAME CONFLICT WITH "VIEW PLOTS AND VIEW GRAPHS" APRIL 1997
      IF(ICOM.EQ.'VIEW'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND.
     1IHARG2(1).EQ.'    ')GOTO9499
      IF(ICOM.EQ.'VIEW'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND.
     1IHARG2(1).EQ.'S  ')GOTO9499
      IF(ICOM.EQ.'VIEW'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP'.AND.
     1IHARG2(1).EQ.'H  ')GOTO9499
      IF(ICOM.EQ.'VIEW'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP'.AND.
     1IHARG2(1).EQ.'HS ')GOTO9499
      IF(ICOM.EQ.'LIST'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND.
     1IHARG2(1).EQ.'    ')GOTO9499
      IF(ICOM.EQ.'LIST'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT'.AND.
     1IHARG2(1).EQ.'S  ')GOTO9499
      IF(ICOM.EQ.'LIST'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP'.AND.
     1IHARG2(1).EQ.'H  ')GOTO9499
      IF(ICOM.EQ.'LIST'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'GRAP'.AND.
     1IHARG2(1).EQ.'HS ')GOTO9499
C
      IF(ICOM.EQ.'LIST')GOTO9400
      IF(ICOM.EQ.'TYPE')GOTO9400
CCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 1992
      IF(ICOM.EQ.'VIEW')GOTO9400
      IF(ICOM.EQ.'PREV')GOTO9400
CCCC THE FOLLOWING 2 LINES WERE ADDED NOVEMBER 1989
      IF(ICOM.EQ.'NLIS')GOTO9400
      IF(ICOM.EQ.'NTYP')GOTO9400
CCCC THE FOLLOWING 2 LINES WERE ADDED SEPTEMBER 1992
      IF(ICOM.EQ.'NVIE')GOTO9400
      IF(ICOM.EQ.'NPRE')GOTO9400
      GOTO9499
C
 9400 CONTINUE
CCCCC 2 LINES OF ARGS (IHELMX THROUGH NCPOSH) WERE ADDED JULY 1989
CCCCC THE FOLLOWING LINE WAS CHANGED NOVEMBER 1989
CCCCC CALL DPLIST(IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
      CALL DPLIST(ICOM,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
     1IHELMX,
     1ICPREH,NCPREH,ICPOSH,NCPOSH,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9499
C
 9499 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               **********************************
C               **  TREAT THE SAVE PLOT   CASE  **
C               **********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO9500
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'S   ')GOTO9500
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'H   ')GOTO9500
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'HS  ')GOTO9500
      IF(ICOM.EQ.'SG  ')GOTO9500
      IF(ICOM.EQ.'SP  ')GOTO9500
      GOTO9509
C
 9500 CONTINUE
      CALL DPSAPL(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
CCCCC1IANSSV,IREPMX,IPOINT,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9509
C
C
C               **********************************
C               **  TREAT THE SAVE MEMORY CASE  **
C               **********************************
C
 9509 CONTINUE
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'MEMO'.AND.IHARG2(1).EQ.'RY  ')GOTO9510
      IF(NUMARG.GE.1.AND.ICOM.EQ.'SAVE'.AND.
     1IHARG(1).EQ.'ALL '.AND.IHARG2(1).EQ.'    ')GOTO9510
      GOTO9599
C
 9510 CONTINUE
      CALL DPSAVE(IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9599
C
 9599 CONTINUE
C
C               **************************************
C               **  TREAT THE GUI SAVE PLOT CONTROL **
C               **********************************
C
      IF(ICOM.EQ.'GUI')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SAVE'.AND.
     1     IHARG(2).EQ.'PLOT'.AND.IHARG(3).EQ.'CONT')THEN
           CALL DPSAPC(IBUGS2,ISUBRO,IFOUND,IERROR)
           IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               **************************************
C               **  TREAT THE SAVE (COMMANDS) CASE  **
C               **************************************
C
CCCCC DECEMBER 1993.  CHECK FOR CONFLICT WITH S CHART COMMAND
      IF(NUMARG.GE.1)THEN
        IF(IHARG(1).EQ.'CONT')GOTO9699
        IF(IHARG(1).EQ.'CHAR')GOTO9699
      END IF
      IF(ICOM.EQ.'SAVE')GOTO9600
      IF(ICOM.EQ.'S')GOTO9600
      GOTO9699
C
 9600 CONTINUE
      CALL DPSACO(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IANSSV,IREPMX,IPOINT,
     1ISACNC,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9699
C
 9699 CONTINUE
C
C               ****************************************
C               **  TREAT THE AUTOPLOT (SWITCH) CASE  **
C               ****************************************
C
      IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'PLOT')GOTO9700
      GOTO9799
C
 9700 CONTINUE
      CALL DPAUPL(IHARG,NUMARG,
     1IAUTSW,IAUTEX,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO9799
C
 9799 CONTINUE
C
C               **********************************
C               **  TREAT THE CURSOR SIZE CASE  **
C               **********************************
C
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SIZE')GOTO10100
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'HEIG')GOTO10100
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SIZE')GOTO10100
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'HEIG')GOTO10100
      GOTO10199
C
10100 CONTINUE
      CALL DPCUSZ(IHARG,IARGT,ARG,NUMARG,DEFCSZ,
     1ACURSZ,IFOUND,IERROR)
      PDIAHE=ACURSZ
      PDIAWI=PDIAHE/2.0
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')GOTO10110
      GOTO10119
C
10110 CONTINUE
CCCCC ICOPSW='OFF'
CCCCC NUMCOP=0
CCCCC CALL DPCLPL(ICOPSW,NUMCOP,
CCCCC1PGRAXF,PGRAYF,
CCCCC1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
CCCCC1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
CCCCC CALL DPCLDE
C0119 CONTINUE
      IF(NUMDEV.LE.0)GOTO10119
      DO10112IDEVIC=1,NUMDEV
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO10112
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
      IGUNIT=IDUNIT(IDEVIC)
      CALL DPOPDE
      IBELSJ='OFF'
      NUMRIJ=0
      IERASJ='OFF'
      IBACCJ='JUNK'
      CALL DPOPPL(IGRASW,
     1IBELSJ,NUMRIJ,IERASJ,
     1IBACCJ)
      ICOPSJ='OFF'
      NUMCOJ=0
      CALL DPCLPL(ICOPSJ,NUMCOJ,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
      CALL DPCLDE
10112 CONTINUE
10119 CONTINUE
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10199 CONTINUE
C
C               *************************************
C               **  TREAT THE CURSOR SPACING CASE  **
C               *************************************
C
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SPAC')GOTO10200
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'GAP')GOTO10200
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SPAC')GOTO10200
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'GAP')GOTO10200
      GOTO10299
C
10200 CONTINUE
      DEFCSP=0.0
      CALL DPCUSP(IHARG,IARGT,ARG,NUMARG,DEFCSP,
     1PDIAVG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10299 CONTINUE
C
C               *****************************************
C               **  TREAT THE CURSOR COORDINATES CASE  **
C               *****************************************
C
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'COOR')GOTO10300
      IF(ICOM.EQ.'CURS'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LOCA')GOTO10300
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'COOR')GOTO10300
      IF(ICOM.EQ.'DIAL'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'LOCA')GOTO10300
      GOTO10399
C
10300 CONTINUE
      CALL DPCUCO(IHARG,IARGT,ARG,NUMARG,PDIAYC,
     1PDIAY2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.AND.IERROR.EQ.'NO')GOTO10310
      GOTO10319
C
10310 CONTINUE
      IF(NUMDEV.LE.0)GOTO10319
      DO10312IDEVIC=1,NUMDEV
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO10312
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
      IGUNIT=IDUNIT(IDEVIC)
      CALL DPOPDE
      IBELSJ='OFF'
      NUMRIJ=0
      IERASJ='OFF'
      IBACCJ='JUNK'
      CALL DPOPPL(IGRASW,
     1IBELSJ,NUMRIJ,IERASJ,
     1IBACCJ)
      ICOPSJ='OFF'
      NUMCOJ=0
      CALL DPCLPL(ICOPSJ,NUMCOJ,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
      CALL DPCLDE
10312 CONTINUE
10319 CONTINUE
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10399 CONTINUE
C
C               **************************************
C               **  TREAT THE PREPOST  DEVICE CASE  **
C               **************************************
C
      IF(ICOM.EQ.'PREP'.AND.ICOM2.EQ.'OST')GOTO10400
      GOTO10499
C
10400 CONTINUE
      CALL DPPRPO(ICOM,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IPPDE1,IPPDE2,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10499 CONTINUE
C
C               ****************************
C               **  TREAT THE SEARCH CASE **
C               ****************************
C
      IF(ICOM.EQ.'SEAR')GOTO10500
      GOTO10599
C
10500 CONTINUE
      ISEART='1LIN'
      IF(ICOM2.EQ.'CHB')ISEART='BLAN'
      IF(ICOM2.EQ.'CHBL')ISEART='BLAN'
      IF(ICOM2.EQ.'CHD')ISEART='----'
      IF(ICOM2.EQ.'CHDA')ISEART='----'
CCCCC THE FOLLOWING LINE WAS ADDED      JANUARY 1994
      IF(ICOM2.EQ.'CH1 ')ISEART='FIRS'
      CALL DPSEAR(IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,ISEART,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      GOTO10599
C
10599 CONTINUE
C
C               ****************************************
C               **  TREAT THE LOWESS FRACTION  CASE   **
C               ****************************************
C
      IF(ICOM.EQ.'LOWE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'FRAC')GOTO10600
      IF(ICOM.EQ.'LOWE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'DECI')GOTO10600
      IF(ICOM.EQ.'LOWE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PROP')GOTO10600
      IF(ICOM.EQ.'LOWE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PERC')GOTO10600
      GOTO10699
C
10600 CONTINUE
C
      CALL DPLOFR(IHARG,IARGT,ARG,NUMARG,
     1ALOWFR,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10699 CONTINUE
C
C               *********************************************
C               **  TREAT THE KERNEL DENSITY WIDTH  CASE   **
C               *********************************************
C
      IF(ICOM.EQ.'KERN')THEN
        IF(IHARG(1).EQ.'DENS'.AND.IHARG(2).EQ.'WIDT')THEN
          ISHIFT=1
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPKDWI(IHARG,IARGT,ARG,NUMARG,
     1                PKDEWI,DEFKWI,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ELSEIF(IHARG(1).EQ.'WIDT')THEN
          CALL DPKDWI(IHARG,IARGT,ARG,NUMARG,
     1                PKDEWI,DEFKWI,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
        IF(IHARG(1).EQ.'DENS'.AND.IHARG(2).EQ.'POIN')THEN
          ISHIFT=1
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPKDNP(IHARG,IARGT,ARG,NUMARG,
     1                IKDENP,IDEFKN,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ELSEIF(IHARG(1).EQ.'POIN')THEN
          CALL DPKDNP(IHARG,IARGT,ARG,NUMARG,
     1                IKDENP,IDEFKN,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ELSEIF(IHARG(1).EQ.'DENS'.AND.IHARG(2).EQ.'NUMB'.AND.
     1         IHARG(3).EQ.'OF  '.AND.IHARG(4).EQ.'POIN')THEN
          ISHIFT=3
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPKDNP(IHARG,IARGT,ARG,NUMARG,
     1                IKDENP,IDEFKN,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ELSEIF(IHARG(1).EQ.'DENS'.AND.IHARG(2).EQ.'NUMB'.AND.
     1         IHARG(3).EQ.'POIN')THEN
          ISHIFT=2
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
          CALL DPKDNP(IHARG,IARGT,ARG,NUMARG,
     1                IKDENP,IDEFKN,IFOUND,IERROR)
          IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
        ENDIF
      ENDIF
C
C               *********************************************
C               **  TREAT THE BOOSTRAP SAMPLE SIZE  CASE   **
C               *********************************************
C
      IF(ICOM.EQ.'BOOT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SAMP')GOTO10700
      IF(ICOM.EQ.'BOOT'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'SIZE')GOTO10700
      GOTO10799
C
10700 CONTINUE
C
      CALL DPBOSS(IHARG,IARGT,IARG,NUMARG,
     1IBOOSS,IDEBOO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10799 CONTINUE
C
C               ***************************
C               **  TREAT THE SYSTEM CASE**
C               ***************************
C
      IF(ICOM.EQ.'SYST')GOTO10800
CCCCC THE FOLLOWING 4 LINES WERE ADDED SEPTEMBER 1990
      IF(ICOM.EQ.'DOS')GOTO10800
      IF(ICOM.EQ.'UNIX')GOTO10800
      IF(ICOM.EQ.'VMS')GOTO10800
      IF(ICOM.EQ.'OS')GOTO10800
      GOTO10899
C
10800 CONTINUE
C
C FOLLOWING LINE CHANGED MARCH, 1990 (ADD LOWER CASE FOR UNIX)
CCCCC CALL DPSYST(IANS,IWIDTH,
      CALL DPSYST(IANS,IANSLC,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
CCCCC THE FOLLOWING LINE WAS AUGMENTED NOVEMBER 1989
CCCCC1IBUGD2,IFOUND,IERROR)
CCCCC THE FOLLOWING LINE WAS FIXED JUNE 1990
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
10899 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED JUNE 1989
C               *************************************
C               **  TREAT THE CAPTURE CASE         **
C               **  TREAT THE END CAPTURE CASE     **
C               **  TREAT THE END OF CAPTURE CASE  **
C               **  TREAT THE REDIRECT CASE        **
C               **  TREAT THE END REDIRECT CASE    **
C               **  TREAT THE END OF REDIRECT CASE **
C               *************************************
C
      IF(ICOM.EQ.'CAPT')GOTO11100
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'CAPT')GOTO11100
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'CAPT')GOTO11100
      IF(ICOM.EQ.'REDI')GOTO11100
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'REDI')GOTO11100
      IF(ICOM.EQ.'END '.AND.NUMARG.GE.2.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'REDI')GOTO11100
      GOTO11199
C
11100 CONTINUE
      CALL DPCAPT(ICOM,ICOM2,
CCCCC JUNE 2002.  ADD ICAPTY
CCCCC JANUARY 2006.  ADD ICAPSC
     1ICAPSW,ICAPTY,ICAPSC,IPRDEF,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,MAXNAM,IANSLC,IANS,IWIDTH,
     1IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IOFILE,
CCCCC JUNE 2002.  ADD FOLLOWING ARGUMENTS TO ALLOW "CALL DPERAS".
     1IBACCO,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
     1IDFONT,
CCCCC END OF NEW ARGUMENTS
     1IREPCH,IMPSW,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11199 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS INSERTED NOVERMBER 1989
C               **************************************************
C               **  TREAT THE YATES COEF/T/RESSD CUTOFF CASE    **
C               **************************************************
C
      IF(ICOM.EQ.'YATE')GOTO11210
      GOTO11299
C
11210 CONTINUE
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'CUTO'.AND.
     1IHARG2(2).EQ.'FF')GOTO11220
      GOTO11299
11220 CONTINUE
      CALL DPYACU(IHARG,IARGT,ARG,NUMARG,
     1YATCCU,YATTCU,YATRCU,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11299 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS INSERTED NOVERMBER 1989
C               **************************************************
C               **  TREAT THE YATES OUTPUT CASE                 **
C               **************************************************
C
      IF(ICOM.EQ.'YATE')GOTO11310
      GOTO11399
C
11310 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OUTP'.AND.
     1IHARG2(1).EQ.'UT')GOTO11320
      GOTO11399
11320 CONTINUE
      CALL DPYAOU(IHARG,NUMARG,
     1IYATOS,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11399 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS INSERTED NOVERMBER 1989
C               **************************************************
C               **  TREAT THE COLUMN RULER CASE                 **
C               **  TREAT THE        RULER CASE                 **
C               **************************************************
C
      IF(ICOM.EQ.'COLU'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'RULE')GOTO11410
      IF(ICOM.EQ.'RULE')GOTO11410
      IF(ICOM.EQ.'COLU'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'NRUL')GOTO11410
      IF(ICOM.EQ.'NRUL')GOTO11410
      GOTO11499
C
11410 CONTINUE
      CALL DPCORU(ICOM,IHARG,NUMARG,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11499 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   MAY 1990
C               ******************************************
C               **  TREAT THE COMMENT    CHARACTER CASE **
C               ******************************************
C
      IF(ICOM.EQ.'COMM')GOTO11510
      GOTO11599
C
11510 CONTINUE
      CALL DPCOMM(IHARG,NUMARG,
     1IDEFCZ,
     1ICOMCH,
     1ICOMSW,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11599 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MARCH 1992
C               ******************************************
C               **  TREAT THE PRINTER TYPE/FORMAT CASE  **
C               ******************************************
C
      IF(ICOM.EQ.'PRIN'.AND.ICOM2.EQ.'TER ')GOTO11610
      IF(ICOM.EQ.'LP  ')GOTO11610
      GOTO11699
C
11610 CONTINUE
CCCCC CALL DPPRFO(IHARG,NUMARG,IPRITY,IBUGS2,IERROR)
      CALL DPPRFO(IHARG,NUMARG,IPRITY,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
11699 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED   MARCH 1992
C               ******************************************
C               **  TREAT THE FILE TYPE/FORMAT CASE     **
C               ******************************************
C
      IF(ICOM.EQ.'FILE')GOTO11710
      GOTO11799
C
11710 CONTINUE
CCCCC CALL DPFIFO(IHARG,NUMARG,IOUTTY,IBUGS2,IERROR)
      CALL DPFIFO(IHARG,NUMARG,IOUTTY,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
11799 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   AUGUST 1992
C               ******************************************
C               **  TREAT THE VECTOR FORMAT        CASE **
C               ******************************************
C
      IF(ICOM.EQ.'VECT'.AND.IHARG(1).EQ.'FORM')GOTO11810
      GOTO11899
C
11810 CONTINUE
      CALL DPVCFM(IHARG,NUMARG,
     1IDEFVF,
     1IVCFMT,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11899 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   AUGUST 1992
C               ******************************************
C               **  TREAT THE VECTOR ARROW         CASE **
C               ******************************************
C
      IF(ICOM.EQ.'VECT'.AND.IHARG(1).EQ.'ARRO')GOTO11910
      GOTO11999
C
11910 CONTINUE
      CALL DPVCAR(IHARG,NUMARG,
     1IDEFVA,IDEFVO,
     1IVCARR,IVCOPN,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
11999 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   NOVEMBER 1992
C               ******************************************
C               **  TREAT THE ANDREWS INCREMENT    CASE **
C               ******************************************
C
      IF(ICOM.EQ.'ANDR'.AND.IHARG(1).EQ.'INCR')GOTO12110
      GOTO12199
C
12110 CONTINUE
      CALL DPANIN(IHARG,IARGT,ARG,NUMARG,DEFAIN,
     1ANDINC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12199 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   JULY 1993
C               ******************************************
C               **  TREAT THE FRACTAL ITERATIONS   CASE **
C               ******************************************
C
      IF(ICOM.EQ.'FRAC'.AND.IHARG(1).EQ.'ITER')GOTO12210
      GOTO12299
C
12210 CONTINUE
      CALL DPFRIT(IHARG,IARGT,ARG,NUMARG,MAXPOP,
     1IFRAIT,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12299 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   JULY 1993
C               ******************************************
C               **  TREAT THE FRACTAL TYPE         CASE **
C               ******************************************
C
      IF(ICOM.EQ.'FRAC'.AND.IHARG(1).EQ.'TYPE')GOTO12310
      GOTO12399
C
12310 CONTINUE
      CALL DPFRTY(IHARG,NUMARG,
     1IDEFFT,
     1IFRATY,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12399 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   JULY 1993
C               **********************************************
C               **  TREAT THE PRINCIPLE COMPONENT TYPE CASE **
C               **********************************************
C
      IF(ICOM.EQ.'PRIN'.AND.IHARG(1).EQ.'COMP'.AND.
     1IHARG(2).EQ.'TYPE')GOTO12410
      GOTO12499
C
12410 CONTINUE
      CALL DPPCTY(IHARG,NUMARG,
     1IDEFPT,
     1IPCMTY,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12499 CONTINUE
C
C               ****************************************
C               **  TREAT THE LOWESS DEGREE  CASE     **
C               ****************************************
C
      IF(ICOM.EQ.'LOWE'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'DEGR')GOTO12500
      GOTO12599
C
12500 CONTINUE
C
      CALL DPLODG(IHARG,IARGT,ARG,NUMARG,
     1ALOWDG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12599 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED JUNE 1994.
C               ***********************************************
C               **  TREAT THE OPTIMIZATION TOLERANCE  CASE   **
C               ***********************************************
C
      IF(ICOM.EQ.'OPTI'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'TOLE')GOTO12600
      IF(ICOM.EQ.'OPTI'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'ACCU')GOTO12600
      GOTO12699
C
12600 CONTINUE
C
      CALL DPOPAC(IHARG,IARGT,ARG,NUMARG,DEFOAC,
     1OPTACC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12699 CONTINUE
C
CCCCC THE FOLLOWING SECTION  WAS ADDED   MAY 1994  (JJF)
C               *****************************************
C               **  TREAT THE COPY (= COPY FILE) CASE  **
C               *****************************************
C
      IF(IBUGSU.EQ.'ON')CALL TRACE2('COFI','MAIN','SU  ')
C
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'COPY')THEN
            CALL DPCOFI(ICOM,IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,
     1      IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
            IFOUND='YES'
            GOTO9000
         ENDIF
      ENDIF
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY ALAN   FEBRUARY 1995
C               **********************************************
C               **  TREAT THE OPTIMIZATION METHOD      CASE **
C               **********************************************
C
      IF(ICOM.EQ.'OPTI'.AND.NUMARG.GE.1.AND.
     1IHARG(1).EQ.'METH')GOTO12710
      GOTO12799
C
12710 CONTINUE
      CALL DPOPME(IHARG,NUMARG,
     1IDEFOM,IDEFHS,
     1IOPTME,IOPTHE,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12799 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED BY JIM   SEPTEMBER 1995
C               **********************************************
C               **  TREAT THE   INIT   CASE                 **
C               **  (USEFUL FOR SIGN-ON DEBUGGING)          **
C               **********************************************
C
      IF(ICOM.EQ.'INIT')THEN
         IBUGIN='ON'
C
         ICOMHO=ICOM
         ICOMH2=ICOM2
C
         WRITE(ICOUT,10811)
10811    FORMAT('FROM MAINSU--BEFORE CALL TO MAININ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,10812)IBUGMA,IBUGIN,ICOM,ICOM2,ICOMHO,ICOMH2,NUMDEV
10812    FORMAT('IBUGMA,IBUGIN,ICOM,ICOM2,ICOMHO,ICOMH2,NUMDEV = ',
     1   A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4,I8)
         CALL DPWRST('XXX','BUG ')
C
         CALL MAININ(IBUGIN,ICOMHO,ICOMH2)
         IBUGIN='OFF'
         IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               *******************************
C               **  TREAT THE WEB HELP CASE  **
C               *******************************
C
      IF(ICOM.EQ.'WEB'.AND.IHARG(1).EQ.'HELP')GOTO12700
      GOTO12790
C
12700 CONTINUE
      CALL DPHELW(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANS,
     1IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12790 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED MARCH 1999.
C               ***********************************
C               **  TREAT THE WEB HANDBOOK CASE  **
C               ***********************************
C
      IF(ICOM.EQ.'HAND')THEN
        ICOM='WEB '
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGS2,IERROR)
        IHARG(1)='HAND'
        IHARG2(1)='BOOK'
        NUMARG=1
        CALL DPHANW(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANS,
     1              IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
      IF(ICOM.EQ.'WEB'.AND.IHARG(1).EQ.'HAND')THEN
        CALL DPHANW(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANS,
     1              IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               *******************************
C               **  TREAT THE WEB      CASE  **
C               **  NOTE: SET "HANDBOOK" =   **
C               **        "WEB HANDBOOK      **
C               *******************************
C
      IF(ICOM.EQ.'WEB')GOTO12800
      IF(ICOM.EQ.'HAND')THEN
        ICOM='WEB '
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGS2,IERROR)
        IHARG(1)='HAND'
        IHARG2(1)='BOOK'
        NUMARG=1
        GOTO12800
      ENDIF
      GOTO12890
C
12800 CONTINUE
      CALL DPWEB(IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,IANSLC,
     1IWIDTH,IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
12890 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               **********************************
C               **  TREAT THE REPEAT GRAPH CASE **
C               **********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REPE'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REPE'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'S   ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REPE'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'H   ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'REPE'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'HS  ')GOTO12900
      IF(ICOM.EQ.'RG  ')GOTO12900
      IF(ICOM.EQ.'RP  ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'VIEW'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'VIEW'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'S   ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'VIEW'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'H   ')GOTO12900
      IF(NUMARG.GE.1.AND.ICOM.EQ.'VIEW'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'HS  ')GOTO12900
      IF(ICOM.EQ.'VG  ')GOTO12900
      IF(ICOM.EQ.'VP  ')GOTO12900
      GOTO12990
C
12900 CONTINUE
      CALL DPREGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
12990 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               **********************************
C               **  TREAT THE LIST   GRAPH CASE **
C               **********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'LIST'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO13000
      IF(NUMARG.GE.1.AND.ICOM.EQ.'LIST'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'S   ')GOTO13000
      IF(NUMARG.GE.1.AND.ICOM.EQ.'LIST'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'H   ')GOTO13000
      IF(NUMARG.GE.1.AND.ICOM.EQ.'LIST'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'HS  ')GOTO13000
      IF(ICOM.EQ.'LG  ')GOTO13000
      IF(ICOM.EQ.'LP  ')GOTO13000
      GOTO13090
C
13000 CONTINUE
      CALL DPLIGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
13090 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED APRIL 1997.
C               **********************************
C               **  TREAT THE CYCLE  GRAPH CASE **
C               **********************************
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'CYCL'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'    ')GOTO13100
      IF(NUMARG.GE.1.AND.ICOM.EQ.'CYCL'.AND.
     1IHARG(1).EQ.'PLOT'.AND.IHARG2(1).EQ.'S   ')GOTO13100
      IF(NUMARG.GE.1.AND.ICOM.EQ.'CYCL'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'H   ')GOTO13100
      IF(NUMARG.GE.1.AND.ICOM.EQ.'CYCL'.AND.
     1IHARG(1).EQ.'GRAP'.AND.IHARG2(1).EQ.'HS  ')GOTO13100
      IF(ICOM.EQ.'CG  ')GOTO13100
CCCCC MARCH 1998.  CONFLICT WITH CP PLOT COMMAND.
      IF(ICOM.EQ.'CP  '.AND.IHARG(1).NE.'PLOT')GOTO13100
      GOTO13190
C
13100 CONTINUE
      CALL DPCYGR(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
13190 CONTINUE
C
C               ***************************
C               **  TREAT THE CD     CASE**
C               ***************************
C
      IF(ICOM.EQ.'CD  ')GOTO13200
      GOTO13299
C
13200 CONTINUE
C
      CALL DPCDIR(IANS,IANSLC,IWIDTH,
     1IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM,
     1IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13299 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE SATTERWAITE APPROXIMATION CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13399
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SATT'.AND.IHARG(2).EQ.'APPR')
     1GOTO13300
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SATT')GOTO13300
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'APPR')GOTO13300
      GOTO13399
C
13300 CONTINUE
C
      CALL DPRESA(IHARG,NUMARG,IDEFSA,IRECSA,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13399 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE PROBABILITY CONTENT       CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13499
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PROB'.AND.IHARG(2).EQ.'PLOT')
     1GOTO13499
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PROB'.AND.IHARG(2).EQ.'CONT')
     1GOTO13400
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONT')GOTO13400
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PROB')GOTO13400
      GOTO13499
C
13400 CONTINUE
C
      CALL DPREPC(IHARG,IARGT,ARG,NUMARG,DEFRPC,
     1RECIPC,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13499 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE CONFIDENCE                CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13599
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CONF')GOTO13500
      GOTO13599
C
13500 CONTINUE
C
      CALL DPRECO(IHARG,IARGT,ARG,NUMARG,DEFRCO,
     1RECICO,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13599 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE FIT DEGREE                CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13699
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FIT '.AND.IHARG(2).EQ.'DEGR')
     1GOTO13600
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DEGR')GOTO13600
      GOTO13699
C
13600 CONTINUE
C
      CALL DPREDG(IHARG,IARGT,ARG,NUMARG,DEFRDG,
     1RECIDG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13699 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE ANOVA FACTORS             CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13799
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'ANOV'.AND.IHARG(2).EQ.'FACT')
     1GOTO13700
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'FACT')GOTO13700
      GOTO13799
C
13700 CONTINUE
C
      CALL DPREFA(IHARG,IARGT,ARG,NUMARG,DEFRFA,
     1RECIFA,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13799 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE OUTPUT                    CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13899
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'OUTP')GOTO13800
      GOTO13899
C
13800 CONTINUE
C
      CALL DPRETN(IHARG,NUMARG,IDEFTN,IRECTN,
     1IBUGS2,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13899 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE CORRELATION               CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO13999
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CORR')GOTO13900
      GOTO13999
C
13900 CONTINUE
C
      CALL DPRECR(IHARG,IARGT,IARG,NUMARG,IDEFR9,IRECC1,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
13999 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE SIMCOV REPLICATES         CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO14099
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIMC'.AND.IHARG(2).EQ.'REPL')
     1GOTO14000
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'REPL'.AND.IHARG(2).EQ.'SIMC')
     1GOTO14000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIMC')GOTO14000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'REPL')GOTO14000
      GOTO14099
C
14000 CONTINUE
C
      CALL DPRES1(IHARG,IARGT,IARG,NUMARG,IDEFR7,IRECR1,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
14099 CONTINUE
C
C               ******************************************************
C               **  TREAT THE RECIPE SIMPVT REPLICATES         CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO14199
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'SIMP'.AND.IHARG(2).EQ.'REPL')
     1GOTO14100
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'REPL'.AND.IHARG(2).EQ.'SIMP')
     1GOTO14100
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'SIMP')GOTO14100
      GOTO14199
C
14100 CONTINUE
C
      CALL DPRESZ(IHARG,IARGT,IARG,NUMARG,IDEFR8,IRECR2,
     1IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
14199 CONTINUE
C
CCCCC FOLLOWING SECTION ADDED APRIL 1998.
C               ******************************************************
C               **  TREAT THE RECIPE FIT   FACTORS             CASE **
C               ******************************************************
C
      IF(ICOM.NE.'RECI')GOTO14299
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'FIT '.AND.IHARG(2).EQ.'FACT')
     1GOTO14200
C
14200 CONTINUE
C
      CALL DPREFF(IHARG,IARGT,ARG,NUMARG,DEFRFF,
     1RECIFF,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
C
14299 CONTINUE
C
C               ********************************
C               **  TREAT THE AUTO TEXT CASE  **
C               ********************************
C
      IF(ICOM.EQ.'AUTO'.AND.
     1NUMARG.GE.1.AND.IHARG(1).EQ.'TEXT')THEN
        CALL DPAUTX(IHARG,NUMARG,
     1              IATXSW,IFOUND,IERROR)
        IF(IFOUND.EQ.'YES'.OR.IERROR.EQ.'YES')GOTO9000
      ENDIF
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGSU.EQ.'OFF'.OR.ISUBRO.EQ.'INSU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MAINSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGSU,IBUGS2
 9013 FORMAT('IBUGSU,IBUGS2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IBUGCO,IBUGEV,IBUGQ
 9015 FORMAT('IBUGCO,IBUGEV,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IANGLU
 9017 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ISQUAR,IBOOSS,IDEBOO
 9018 FORMAT('ISQUAR,IBOOSS,IDEBOO = ',A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IMACRO,IMACNU,IMACCS,IOFILE
 9019 FORMAT('IMACRO,IMACNU,IMACCS,IOFILE = ',A4,I8,2X,A12,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9020)ICRENU,ICREST
C9020 FORMAT('ICRENU,ICREST = ',I8,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IFENSW
 9021 FORMAT('IFENSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IFOUND,IERROR
 9022 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)ICOM,ICOM2
 9023 FORMAT('ICOM,ICOM2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)NUMARG
 9028 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9030I=1,NUMARG
      WRITE(ICOUT,9031)I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I)
 9031 FORMAT('I,IHARG(I),IHARG2(I),IARGT(I),IARG(I),ARG(I) = ',
     1I8,2X,A4,2X,A4,2X,A4,2X,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9030 CONTINUE
      WRITE(ICOUT,9032)NUMCHA
 9032 FORMAT('NUMCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)(IA(I),I=1,100)
 9033 FORMAT('(IA(I),I=1,100) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IMACRO,IPROGR,ICONCL
 9035 FORMAT('IMACRO,IPROGR,ICONCL = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)IMACNU
 9036 FORMAT('IMACNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ISACNC
 9041 FORMAT('ISACNC = ',80A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IAUTSW,IAUTEX
 9042 FORMAT('IAUTSW,IAUTEX = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)IHELMX,IFTEXP
 9043 FORMAT('IHELMX,IFTEXP = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)IFORSW
 9044 FORMAT('IFORSW = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,9051)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
 9051 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IPRITY,IOUTTY
 9052 FORMAT('IPRITY,IOUTTY = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MAKCDF(X,XI,LAMBDA,THETA,CDF)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM CUMULATIVE
C     DISTRIBUTION FUNCTION. IT HAS THE FOLLOWING CDF:
C         F(X,XI,LAMBDA,THETA) = 1 - 
C                EXP[-XI*(EXP(LAMBDA*X) -1) - XI*THETA*LAMBDA*X)
C                X > 0; LAMBDA, XI > 0, THETA >= 0
C     NOTE THAT THIS IS THE PARAMETERIZATION USED BY THE DIGITAL
C     LIBRARY OF MATHEMATICAL FUNCTIONS (DLMF).  TO USE THE
C     PARAMETERIZATION GIVEN ON PAGE 108-109 OF MEEKER AND ESCOBAR,
C     DO THE FOLLOWING BEFORE CALLING THIS ROUTINE:
C
C         XI(DLMF) = GAMMA(MEEKER)/K(MEEKER)
C         LAMBDA(DLMF) = K(MEEKER)
C         THETA(DLMF) = LAMBDA(MEEKER)/GAMMA(MEEKER)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
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/12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL LAMBDA
C
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DLMBDA
      DOUBLE PRECISION DTHETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
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
      CDF=0.0
      IF(X.LE.0.0)GOTO9999
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,111)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (XI) TO MAKCDF')
  102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (LAMBDA) TO')
  107 FORMAT('      MAKCDF IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  111 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER (THETA) TO')
  112 FORMAT('      MAKCDF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DXI=DBLE(XI)
      DLMBDA=DBLE(LAMBDA)
      DTHETA=DBLE(THETA)
C
      DTERM1=-DXI*(DEXP(DLMBDA*DX) - 1.0D0) - DXI*DLMBDA*DTHETA*DX
C
      IF(DTERM1.LE.-80.D0)THEN
        CDF=1.0
        GOTO9999
      ELSEIF(DTERM1.GE.80.D0)THEN
        CDF=0.0
        WRITE(ICOUT,401)
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSE
        DCDF=1.0D0 - DEXP(DTERM1)
        CDF=REAL(DCDF)
      ENDIF
  401 FORMAT('***** NON-FATAL DIAGNOSTIC FROM MAKCDF.  THE COMPUTED ',
     1'CDF VALUE EXCEEDS MACHINE PRECISION.')
C
 9999 CONTINUE
      RETURN
      END
      REAL FUNCTION MAKFU2(X)
C
C     PURPOSE--MAKPPF CALLS FZERO TO FIND A ROOT FOR THE PERCENT
C              POINT FUNCTION.  MAKFU2 IS THE FUNCTION FOR WHICH
C              THE ZERO IS FOUND.  IT IS:
C                 P - MAKCDF(X,XI,LAMBDA,THETA)
C              WHERE P IS THE DESIRED PERCENT POINT.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE MAKFU2.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--MAKCDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003.12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      REAL P
      COMMON/MA2COM/P
C
      REAL XI
      REAL LAMBDA
      REAL THETA
      COMMON/MAKCOM/XI,LAMBDA,THETA
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
      CALL MAKCDF(X,XI,LAMBDA,THETA,CDF)
      MAKFU2=P - CDF
      RETURN
      END
      SUBROUTINE MAKCHA(X,XI,LAMBDA,THETA,HAZ)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM CUMULATIVE
C     HAZARD FUNCTION WHICH HAS THE FOLLOWING FORMULA:
C         H(X,XI,LAMBDA,THETA) = 
C                      -[-XI*(EXP(LAMBDA*X) - 1) - XI*THETA*LAMBDA*X]
C                X > 0; LAMBDA, XI > 0, THETA >= 0
C     NOTE THAT THIS IS THE PARAMETERIZATION USED BY THE DIGITAL
C     LIBRARY OF MATHEMATICAL FUNCTIONS (DLMF).  TO USE THE
C     PARAMETERIZATION GIVEN ON PAGE 108-109 OF MEEKER AND ESCOBAR,
C     DO THE FOLLOWING BEFORE CALLING THIS ROUTINE:
C
C         XI(DLMF) = GAMMA(MEEKER)/K(MEEKER)
C         LAMBDA(DLMF) = K(MEEKER)
C         THETA(DLMF) = LAMBDA(MEEKER)/GAMMA(MEEKER)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL LAMBDA
C
      DOUBLE PRECISION DHAZ
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DLMBDA
      DOUBLE PRECISION DTHETA
      DOUBLE PRECISION DX
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
      HAZ=0.0
      IF(X.LE.0.0)GOTO9999
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,111)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (XI) TO MAKCHAZ')
  102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (LAMBDA) TO')
  107 FORMAT('      MAKCHAZ IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  111 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER (THETA) TO')
  112 FORMAT('      MAKCHAZ IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DXI=DBLE(XI)
      DLMBDA=DBLE(LAMBDA)
      DTHETA=DBLE(THETA)
C
      DHAZ=-DXI*(DEXP(DLMBDA*DX) - 1.0D0) - DXI*DLMBDA*DTHETA*DX
      HAZ=-REAL(DHAZ)
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE MAKHAZ(X,XI,LAMBDA,THETA,HAZ)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM
C     HAZARD FUNCTION WHICH HAS THE FOLLOWING FORMULA:
C         h(X,XI,LAMBDA,THETA) = f(X,XI,LAMBDA,THETA)/
C                                -LOG[1 - F(x,XI,LAMBDA,THETA)]
C                              = XI*THETA*LAMBDA + XI*LAMBDA*
C                                EXP(LAMBDA*X)
C                X > 0; LAMBDA, XI > 0, THETA >= 0
C         WHERE f IS THE PROBABILITY DENSITY AND F IS THE
C         CUMULATIVE DISTRIBUTION FUNCTION.
C
C     NOTE THAT THIS IS THE PARAMETERIZATION USED BY THE DIGITAL
C     LIBRARY OF MATHEMATICAL FUNCTIONS (DLMF).  TO USE THE
C     PARAMETERIZATION GIVEN ON PAGE 108-109 OF MEEKER AND ESCOBAR,
C     DO THE FOLLOWING BEFORE CALLING THIS ROUTINE:
C
C         XI(DLMF) = GAMMA(MEEKER)/K(MEEKER)
C         LAMBDA(DLMF) = K(MEEKER)
C         THETA(DLMF) = LAMBDA(MEEKER)/GAMMA(MEEKER)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL LAMBDA
C
      DOUBLE PRECISION DHAZ
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DLMBDA
      DOUBLE PRECISION DTHETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
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
      HAZ=0.0
      IF(X.LE.0.0)GOTO9999
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,111)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (XI) TO MAKHAZZ')
  102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (LAMBDA) TO')
  107 FORMAT('      MAKHAZZ IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  111 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER (THETA) TO')
  112 FORMAT('      MAKHAZZ IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DXI=DBLE(XI)
      DLMBDA=DBLE(LAMBDA)
      DTHETA=DBLE(THETA)
C
      DTERM1=DXI*DTHETA*DLMBDA
      DTERM2=DXI*DLMBDA*DEXP(DLMBDA*DX)
      DHAZ=DTERM1 + DTERM2
      HAZ=REAL(DHAZ)
      HAZ=REAL(DHAZ)
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE MAKPDF(X,XI,LAMBDA,THETA,PDF)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM PROBABILITY
C     DENSITY FUNCTION. VALUE DISTRIBUTION.  IT HAS THE FOLLOWING
C     PDF:
C         F(X,XI,LAMBDA,THETA) = XI*LAMBDA*(THETA + EXP(LAMBDA*X))*
C                EXP[-XI*(EXP(LAMBDA*X) -1) - XI*THETA*LAMBDA*X)
C                X > 0; LAMBDA, XI > 0, THETA >= 0
C     NOTE THAT THIS IS THE PARAMETERIZATION USED BY THE DIGITAL
C     LIBRARY OF MATHEMATICAL FUNCTIONS (DLMF).  TO USE THE
C     PARAMETERIZATION GIVEN ON PAGE 108-109 OF MEEKER AND ESCOBAR,
C     DO THE FOLLOWING BEFORE CALLING THIS ROUTINE:
C
C         XI(DLMF) = GAMMA(MEEKER)/K(MEEKER)
C         LAMBDA(DLMF) = K(MEEKER)
C         THETA(DLMF) = LAMBDA(MEEKER)/GAMMA(MEEKER)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C         LAMBDA = THETA*LAMBDA*XI
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
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/12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL LAMBDA
C
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DLMBDA
      DOUBLE PRECISION DTHETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
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
      PDF=0.0
      IF(X.LE.0.0)THEN
        WRITE(ICOUT,301)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,302)X
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,111)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (XI) TO MAKPDF')
  102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (LAMBDA) TO')
  107 FORMAT('      MAKPDF IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  111 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER (THETA) TO')
  112 FORMAT('      MAKPDF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
  301 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT TO MAKPDF IS')
  302 FORMAT('      NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DXI=DBLE(XI)
      DLMBDA=DBLE(LAMBDA)
      DTHETA=DBLE(THETA)
C
      DTERM1=DLOG(DXI) + DLOG(DLMBDA)
      DTERM2=DLOG(DTHETA + DEXP(DLMBDA*DX))
      DTERM3=-DXI*(DEXP(DLMBDA*DX) - 1.0D0) - DXI*DLMBDA*DTHETA*DX
      DTERM4=DTERM1 + DTERM2 + DTERM3
C
      IF(DTERM4.LE.-80.D0)THEN
        PDF=0.0
        GOTO9999
      ELSEIF(DTERM4.GE.80.D0)THEN
        PDF=0.0
        WRITE(ICOUT,401)
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  401 FORMAT('***** NON-FATAL DIAGNOSTIC FROM MAKPDF.  THE COMPUTED ',
     1'PDF VALUE EXCEEDS MACHINE PRECISION.')
C
      DPDF=DEXP(DTERM4)
      PDF=REAL(DPDF)
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE MAKPPF(P,XI,LAMBDA,THETA,PPF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE GOMPERTZ-MAKEHAM DISTRIBUTION
C              WITH SHAPE PARAMETERS XI, LAMBDA, AND THETA.
C              THIS DISTRIBUTION IS DEFINED FOR POSITIVE X AND THE
C              PERCENT POINT FUNCTION IS COMPUTED BY
C              NUMERICALLY INVERTING THE CDF FUNCTION.
C
C     NOTE THAT THIS IS THE PARAMETERIZATION USED BY THE DIGITAL
C     LIBRARY OF MATHEMATICAL FUNCTIONS (DLMF).  TO USE THE
C     PARAMETERIZATION GIVEN ON PAGE 108-109 OF MEEKER AND ESCOBAR,
C     DO THE FOLLOWING BEFORE CALLING THIS ROUTINE:
C
C         XI(DLMF) = GAMMA(MEEKER)/K(MEEKER)
C         LAMBDA(DLMF) = K(MEEKER)
C         THETA(DLMF) = LAMBDA(MEEKER)/GAMMA(MEEKER)
C
C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PERCENT POINT
C                                FUNCTION IS TO BE EVALUATED.
C                     --XI     = THE FIRST SHAPE PARAMETER
C                     --LAMBDA = THE SECOND SHAPE PARAMETER
C                     --THETA  = THE THIRD SHAPE PARAMETER
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
C             FUNCTION VALUE PPF.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--FZERO.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003.12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      REAL LAMBDA
      REAL PPF
C
      REAL MAKFU2
      EXTERNAL MAKFU2
C
      REAL P2
      COMMON/MA2COM/P2
C
      REAL XI2
      REAL LAMBD2
      REAL THETA2
      COMMON/MAKCOM/XI2,LAMBD2,THETA2
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,XIMBPC,XIMCPW,XIMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      PPF=0.0
C
      IF(P.LT.0.0.OR.P.GE.1.0)THEN
         WRITE(ICOUT,61)
   61    FORMAT('***** ERROR--THE FIRST  INPUT ARGUMENT ',
     1          'TO THE MAKPPF SUBROUTINE ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,62)
   62    FORMAT('      IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL ***')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,63)P
   63    FORMAT('      VALUE OF ARGUMENT = ',G15.7)
         CALL DPWRST('XXX','BUG ')
         PPF=0.0
         GOTO9000
      ENDIF
C
      IF(XI.LE.0.0)THEN
        WRITE(ICOUT,101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,102)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(THETA.LT.0.0)THEN
        WRITE(ICOUT,111)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,112)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
  101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (XI) TO MAKPPF')
  102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (LAMBDA) TO')
  107 FORMAT('      MAKPPF IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  111 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER (THETA) TO')
  112 FORMAT('      MAKPPF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      IF(P.EQ.0.0)THEN
        PPF=0.0
        GOTO9000
      ENDIF
C
C  STEP 1: FIND BRACKETING INTERVAL.  LOWER BOUND IS ZERO.  START WITH
C          10 AS GUESS FOR UPPER BOUND.  MULTIPLY BY 10 UNTIL
C          BRACKETING INTERVAL FOUND.
C
      XLOW=0.0000001
      XUP2=10.0
  200 CONTINUE
        CALL MAKCDF(XUP2,XI,LAMBDA,THETA,PTEMP)
        IF(PTEMP.GT.P)THEN
          XUP=XUP2
        ELSE
          XUP2=XUP2*10.0
          IF(XUP2.GT.CPUMAX/100.)THEN
            WRITE(ICOUT,201)
  201       FORMAT('***** ERROR FROM MAKPPF--UNABLE TO FIND A ',
     1             'BRACKETING INTERVAL')
            CALL DPWRST('XXX','BUG ')
            GOTO9000
          ENDIF
          GOTO200
        ENDIF
C
  300 CONTINUE
      AE=1.E-6
      RE=1.E-6
      P2=P
      XI2=XI
      LAMBD2=LAMBDA
      THETA2=THETA
      CALL FZERO(MAKFU2,XLOW,XUP,XUP,RE,AE,IFLAG)
C
      PPF=XLOW
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
  999   FORMAT(1X)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM MAKPPF--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      PPF VALUE MAY NOT BE COMPUTED TO DESIRED ',
CCCCC1         'TOLERANCE.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,121)
  121   FORMAT('***** WARNING FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      PPF VALUE MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,131)
  131   FORMAT('***** ERROR FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,133)
  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,141)
  141   FORMAT('***** WARNING FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE MAKRAN(N,XI,LAMBDA,THETA,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE THE GOMPERTZ-MAKEHAM DISTIBUTION WITH
C              LOCATION = 0 AND SCALE = 1.  THIS DISTRIBUTION IS
C              DEFINED FOR POSITIVE X AND HAS THE PROBABILITY DENSITY
C              FUNCTION:
C              F(X,XI,LAMBDA,THETA) = XI*LAMBDA*(THETA + EXP(LAMBDA*X))
C                *EXP[-XI*(EXP(LAMBDA*X) -1) - XI*THETA*LAMBDA*X)
C                X > 0; LAMBDA, XI > 0, THETA >= 0
C              XI, LAMBDA, AND THETA ARE SHAPE PARAMETERS.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C                     --XI     = A SINGLE PRECISON SCALAR THAT DEFINES
C                                THE FIRST SHAPE PARAMETER.
C                     --LAMBDA = A SINGLE PRECISON SCALAR THAT DEFINES
C                                THE SECOND SHAPE PARAMETER.
C                     --THETA  = A SINGLE PRECISON SCALAR THAT DEFINES
C                                THE THIRD SHAPE PARAMETER.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N FROM THE COMPERTZ-MAKEHAM
C             DISTRIBUTION WITH LOCATION = 0 AND SCALE = 1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, MAKPPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     METHOD--TRANSFORM NORMAL RANDOM NUMBERS
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
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 (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--2003.12
C     ORIGINAL VERSION--DECEMBER  2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      REAL XI
      REAL THETA
      REAL LAMBDA
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     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT, 5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSEIF(XI.LE.0.0)THEN
        WRITE(ICOUT, 6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)XI
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSEIF(LAMBDA.LE.0.0)THEN
        WRITE(ICOUT, 7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)LAMBDA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSEIF(THETA.LT.0.0)THEN
        WRITE(ICOUT,8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)THETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
    5 FORMAT('***** FATAL ERROR--THE FIRST (N) INPUT ARGUMENT TO THE ',
     1'MAKRAN SUBROUTINE IS NON-POSITIVE *****')
    6 FORMAT('***** FATAL ERROR--THE SECOND (XI) INPUT ARGUMENT TO ',
     1'THE MAKRAN SUBROUTINE IS NON-POSITIVE *****')
    7 FORMAT('***** FATAL ERROR--THE THIRD (LAMBDA) INPUT ARGUMENT ',
     1'TO THE MAKRAN SUBROUTINE IS NON-POSITIVE *****')
    8 FORMAT('***** FATAL ERROR--THE FOURTH (THETA) INPUT ARGUMENT ',
     1'TO THE MAKRAN SUBROUTINE IS NEGATIVE *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
   48 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',F15.7,' *****')
C
C     GENERATE N UNIFORM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N GOMPERTZ-MAKEHAM RANDON NUMBERS USING THE
C     PERCENT POINT FUNCTION TRANSFORMATION.
C
      DO100I=1,N
        XTEMP=X(I)
        CALL MAKPPF(XTEMP,XI,LAMBDA,THETA,PPF)
        X(I)=PPF
  100 CONTINUE
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE MA2CDF(X,ZETA,ETA,CDF)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM CUMULATIVE
C     DISTRIBUTION FUNCTION. THIS USES THE MEEKER AND ESCOBAR
C     PARAMETERIZATION (THIS TAKES THE 3-SHAPE PARAMETER CASE AND
C     RE-PARAMETERRIZES IT TO 2-SHAPE PARAMETERS AND A SCALE
C     PARAMETER.  IT HAS THE FOLLOWING CDF:
C         F(X,ZETA,ETA) = 1 - EXP[C1 - EXP(C2) - C3]
C                X,  > 0; ETA >= 0
C     WITH
C         C1 = EXP(-ZETA)
C         C2 = EXP(LOG(X)) - ZETA
C            = X - ZETA
C         C3 = ETA*EXP(LOG(X))
C            = ETA*X
C
C     PUTTING THIS TOGETHER GIVES
C         F(X,ZETA,ETA) = 1 - EXP[EXP(-ZETA) - EXP(X-ZETA) - ETA*X]
C                X,  > 0; ETA >= 0
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL ZETA
      REAL ETA
C
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DETA
      DOUBLE PRECISION DZETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
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
      CDF=0.0
      IF(X.LE.0.0)GOTO9000
CCCCC IF(ETA.LE.0.0)THEN
CCCCC   WRITE(ICOUT,101)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,102)ETA
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   GOTO9000
CCCCC ENDIF
      IF(ETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)ZETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
CC101 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER (ETA) TO MA2CDF')
CC102 FORMAT('      IS NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ZETA) TO')
  107 FORMAT('      MAKCDF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DETA=DBLE(ETA)
      DZETA=DBLE(ZETA)
C
      DTERM1=DEXP(-DZETA)
      DTERM2=DEXP(DX - DZETA)
      DTERM3=DETA*DX
      DTERM4=DTERM1 - DTERM2 - DTERM3
C
      IF(DTERM4.LE.-80.D0)THEN
        CDF=1.0
      ELSEIF(DTERM4.GE.80.D0)THEN
        CDF=0.0
        WRITE(ICOUT,401)
        CALL DPWRST('XXX','BUG ')
      ELSE
        DCDF=1.0D0 - DEXP(DTERM4)
        CDF=REAL(DCDF)
      ENDIF
  401 FORMAT('***** NON-FATAL DIAGNOSTIC FROM MAKCDF.  THE ',
     1'COMPUTED CDF VALUE EXCEEDS MACHINE PRECISION.')
C
 9000 CONTINUE
      RETURN
      END
      REAL FUNCTION MA2FU2(X)
C
C     PURPOSE--MA2PPF CALLS FZERO TO FIND A ROOT FOR THE PERCENT
C              POINT FUNCTION.  MA2FU2 IS THE FUNCTION FOR WHICH
C              THE ZERO IS FOUND.  IT IS:
C                 P - MA2CDF(X,ZETA,ETA)
C              WHERE P IS THE DESIRED PERCENT POINT.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE MA2FU2.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--MA2CDF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004.7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      REAL P
      COMMON/MA4COM/P
C
      REAL ETA
      REAL ZETA
      COMMON/MA3COM/ETA,ZETA
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
      CALL MA2CDF(X,ZETA,ETA,CDF)
      MA2FU2=P - CDF
      RETURN
      END
      SUBROUTINE MA2CHA(X,ZETA,ETA,CHAZ)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM CUMULATIVE
C     HAZARD FUNCTION. THIS USES THE MEEKER AND ESCOBAR
C     PARAMETERIZATION (THIS TAKES THE 3-SHAPE PARAMETER CASE AND
C     RE-PARAMETERRIZES IT TO 2-SHAPE PARAMETERS AND A SCALE
C     PARAMETER.  IT HAS THE FOLLOWING CDF:
C         F(X,ZETA,ETA) = 1 - 
C                         EXP[EXP(-ZETA) - EXP(X - ZETA) - ETA*X]
C                X,  > 0; ETA >= 0
C     THE CUMULATIVE HAZARD IS:
C         H(X,ZETA,ETA) = -LOG(1 - F(X,ZETA,ETA))
C                        = -EXP(-ZETA) + EXP(X-ZETA) + ETA*X
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL ZETA
      REAL ETA
C
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DETA
      DOUBLE PRECISION DZETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
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
      CHAZ=0.0
      IF(X.LE.0.0)GOTO9000
      IF(ETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)ETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ETA) TO')
  107 FORMAT('      MAKCHAZ IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DETA=DBLE(ETA)
      DZETA=DBLE(ZETA)
C
      DTERM1=DEXP(-DZETA)
      DTERM2=DEXP(DX - DZETA)
      DTERM3=DETA*DX
      DTERM4=DTERM1 - DTERM2 - DTERM3
      CHAZ=-REAL(DTERM4)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE MA2HAZ(X,ZETA,ETA,HAZ)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM HAZARD
C     FUNCTION. THIS USES THE MEEKER AND ESCOBAR
C     PARAMETERIZATION (THIS TAKES THE 3-SHAPE PARAMETER CASE AND
C     RE-PARAMETERRIZES IT TO 2-SHAPE PARAMETERS AND A SCALE
C     PARAMETER.  IT HAS THE FOLLOWING HAZARD FUNCTION:
C         h(X,ZETA,ETA) = ETA + EXP(-ZETA)*EXP(X)
C                         X, ETA >= 0
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL ZETA
      REAL ETA
C
      DOUBLE PRECISION DHAZ
      DOUBLE PRECISION DETA
      DOUBLE PRECISION DZETA
      DOUBLE PRECISION DX
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
      HAZ=0.0
      IF(X.LE.0.0)THEN
        WRITE(ICOUT,103)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,104)X
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      IF(ETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)ETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
  103 FORMAT('***** ERROR--THE INPUT ARGUMENT  TO MA2HAZ IS')
  104 FORMAT('      NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ETA) TO')
  107 FORMAT('      MAKHAZ IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DETA=DBLE(ETA)
      DZETA=DBLE(ZETA)
C
      DHAZ=DETA + DEXP(-DZETA)*DEXP(DX)
      HAZ=REAL(DHAZ)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE MA2PDF(X,ZETA,ETA,PDF)
C
C     THIS SUBROUTINE COMPUTES THE GOMPERTZ-MAKEHAM PROBABILITY
C     DENSITY FUNCTION. THIS USES THE MEEKER AND ESCOBAR
C     PARAMETERIZATION (THIS TAKES THE 3-SHAPE PARAMETER CASE AND
C     RE-PARAMETERRIZES IT TO 2-SHAPE PARAMETERS AND A SCALE
C     PARAMETER.  IT HAS THE FOLLOWING PROBABILITY DENSITY FUNCTION:
C         f(X,ZETA,ETA) = (ETA + EXP(X-ZETA))*
C                         EXP[EXP(-ZETA)-EXP(X-ZETA)-ETA*X]
C                         X, ETA > 0
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      REAL ZETA
      REAL ETA
C
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DETA
      DOUBLE PRECISION DZETA
      DOUBLE PRECISION DX
      DOUBLE PRECISION DZ
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4
      DOUBLE PRECISION DTERM5, DTERM6, DTERM7
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
      PDF=0.0
      IF(X.LE.0.0)THEN
        WRITE(ICOUT,103)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,104)X
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
CCCCC IF(ZETA.LE.0.0)THEN
CCCCC   WRITE(ICOUT,101)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,102)ZETA
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   GOTO9000
CCCCC ENDIF
      IF(ETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)ETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
  103 FORMAT('***** ERROR--THE INPUT ARGUMENT  TO MA2PDF IS')
  104 FORMAT('      NON-POSITIVE.  IT HAS THE VALUE ',E15.7)
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ETA) TO')
  107 FORMAT('      MAKPDF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
      DX=DBLE(X)
      DZETA=DBLE(ZETA)
      DETA=DBLE(ETA)
C
      DTERM1=DETA + EXP(DX-DZETA)
      DTERM2=DEXP(-DZETA) - DEXP(DX-DZETA) - DETA*DX
      DPDF=DTERM1*DEXP(DTERM2)
      PDF=REAL(DPDF)
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE MA2PPF(P,ZETA,ETA,PPF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE GOMPERTZ-MAKEHAM DISTRIBUTION
C              WITH SHAPE PARAMETERS ETA AND ZETA.
C              THIS DISTRIBUTION IS DEFINED FOR POSITIVE X AND THE
C              PERCENT POINT FUNCTION IS COMPUTED BY
C              NUMERICALLY INVERTING THE CDF FUNCTION.
C     INPUT  ARGUMENTS--P      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PERCENT POINT
C                                FUNCTION IS TO BE EVALUATED.
C                     --ZETA l = THE FIRST SHAPE PARAMETER
C                     --ETA    = THE SECOND SHAPE PARAMETER
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT
C             FUNCTION VALUE PPF.
C     PRINTING--NONE.
C     RESTRICTIONS--NONE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--FZERO.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATION INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATION INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004.7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      REAL ETA
      REAL ZETA
      REAL PPF
C
      REAL MA2FU2
      EXTERNAL MA2FU2
C
      REAL P2
      COMMON/MA4COM/P2
C
      REAL ETA2
      REAL ZETA2
      COMMON/MA3COM/ETA2,ZETA2
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,ETAMBPC,ETAMCPW,ETAMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      PPF=0.0
C
      IF(P.LE.0.0.OR.P.GE.1.0)THEN
         WRITE(ICOUT,61)
   61    FORMAT('***** ERROR--THE FIRST  INPUT ARGUMENT ',
     1          'TO THE MA2PPF SUBROUTINE ')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,62)
   62    FORMAT('      IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL ***')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,63)P
   63    FORMAT('      VALUE OF ARGUMENT = ',G15.7)
         CALL DPWRST('XXX','BUG ')
         PPF=0.0
         GOTO9000
      ENDIF
C
      IF(ETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)ETA
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ETA) TO')
  107 FORMAT('      MAKPPF IS NEGATIVE.  IT HAS THE VALUE ',E15.7)
C
C  STEP 1: FIND BRACKETING INTERVAL.  LOWER BOUND IS ZERO.  START WITH
C          10 AS GUESS FOR UPPER BOUND.  MULTIPLY BY 10 UNTIL
C          BRACKETING INTERVAL FOUND.
C
      XLOW=0.0000001
      XUP2=10.0
  200 CONTINUE
        CALL MA2CDF(XUP2,ZETA,ETA,PTEMP)
        IF(PTEMP.GT.P)THEN
          XUP=XUP2
        ELSE
          XUP2=XUP2*10.0
          IF(XUP2.GT.CPUMAX/100.)THEN
            WRITE(ICOUT,201)
  201       FORMAT('***** ERROR FROM MA2PPF--UNABLE TO FIND A ',
     1             'BRACKETING INTERVAL')
            CALL DPWRST('XXX','BUG ')
            GOTO9000
          ENDIF
          GOTO200
        ENDIF
C
  300 CONTINUE
      AE=1.E-6
      RE=1.E-6
      P2=P
      ETA2=ETA
      ZETA2=ZETA
      CALL FZERO(MA2FU2,XLOW,XUP,XUP,RE,AE,IFLAG)
C
      PPF=XLOW
C
      IF(IFLAG.EQ.2)THEN
C
C  NOTE: SUPPRESS THIS MESSAGE FOR NOW.
CCCCC   WRITE(ICOUT,999)
  999   FORMAT(1X)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,111)
CC111   FORMAT('***** WARNING FROM MA2PPF--')
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,113)
CC113   FORMAT('      PPF VALUE MAY NOT BE COMPUTED TO DESIRED ',
CCCCC1         'TOLERANCE.')
CCCCC   CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.3)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,121)
  121   FORMAT('***** WARNING FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,123)
  123   FORMAT('      PPF VALUE MAY BE NEAR A SINGULAR POINT.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.4)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,131)
  131   FORMAT('***** ERROR FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,133)
  133   FORMAT('      APPROPRIATE BRACKETING INTERVAL NOT FOUND.')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(IFLAG.EQ.5)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,141)
  141   FORMAT('***** WARNING FROM MAKPPF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,143)
  143   FORMAT('      MAXIMUM ITERATIONS EXCEEDED.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE MA2RAN(N,ZETA,ETA,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE THE GOMPERTZ-MAKEHAM DISTIBUTION WITH
C              LOCATION = 0 AND SCALE = 1.  THIS DISTRIBUTION IS
C              DEFINED FOR POSITIVE X AND HAS THE PROBABILITY DENSITY
C              FUNCTION:
C              f(X,ETA,ZETA) = (1/X)*EXP(LOG(X))*
C                              [ZETA + EXP[EXP(LOG(X)) - ETA]*
C                              [1 - MA2CDF(X,ETA,ZETA)]
C                              X, ZETA > 0
C             WHERE MA2CDF IS:
C             F(X,ETA,ZETA) = 1 - EXP[C1 - EXP(C2) - C3]
C                             X, ZETA > 0
C             WITH
C                 C1 = EXP(-ETA)
C                 C2 = EXP(LOG(X) - ETA)
C                 C3 = ZETA*EXP(LOG(X))
C
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C                     --ETA    = A SINGLE PRECISON SCALAR THAT DEFINES
C                                THE FIRST SHAPE PARAMETER.
C                     --ZETA   = A SINGLE PRECISON SCALAR THAT DEFINES
C                                THE SECOND SHAPE PARAMETER.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N FROM THE COMPERTZ-MAKEHAM
C             DISTRIBUTION WITH LOCATION = 0 AND SCALE = 1.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EETASTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAETAMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, MA2PPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     METHOD--TRANSFORM NORMAL RANDOM NUMBERS
C     REFERENCE--"STATISTICAL METHODS FOR RELIABILITY DATA",
C                MEEKER AND ESCOBAR, WILEY, 1998, PP. 108-109.
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--2004.7
C     ORIGINAL VERSION--JULY      2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      REAL ETA
      REAL ZETA
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     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT, 5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT, 6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ELSEIF(ZETA.LT.0.0)THEN
        WRITE(ICOUT,106)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,107)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,48)ZETA
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
  106 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER (ZETA) TO THE')
  107 FORMAT('      GOMPERTZ MAKEHAM RANDOM NUMBERS ROUTINE IS ',
     1       'NON-POSITIVE.')
    5 FORMAT('***** THE REQUESTED NUMBER OF RANDOM NUMBERS FOR THE')
    6 FORMAT('      GOMPERTZ-MAKEHAM DISTRIBUTION IS NON-POSITIVE.')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
   48 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',F15.7)
C
C     GENERATE N UNIFORM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N GOMPERTZ-MAKEHAM RANDON NUMBERS USING THE
C     PERCENT POINT FUNCTION TRANSFORMATION.
C
      DO100I=1,N
        XTEMP=X(I)
        CALL MA2PPF(XTEMP,ZETA,ETA,PPF)
        X(I)=PPF
  100 CONTINUE
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE MATARI(YM1,NR1,NC1,YM2,NR2,NC2,NR3,NC3,MAXROM,MAXCOM,
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC SUBROUTINE MATARI(YM1,NR1,NC1,YM2,NR2,NC2,YM3,NR3,NC3,
     1Y1,N1,Y2,N2,Y3,N3,Y4,N4,
     1INDEX,IZROV,IPOSV,
     1DMEAN,DSSQD,P1,P2,BETA,
     1YS1,YS2,YS3,YS4,
     1IMCASE,IUPFLG,IMSUBC,ITYPA1,ITYPA2,ITYPA3,ITYPA4,NUMVAR,IWRITE,
     1YM9,NR9,NC9,VECT9,NVECT9,SCAL9,ITYP9,
CCCCC AUGUST 1993.
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC1YMJUNK,YMJUN2,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CARRY OUT MATRIX     ARITHMETIC OPERATIONS
C              OF THE REAL DATA IN MATRICES YM1 AND YM2.
C
C     OPERATIONS--ADDITION
C                 SUBTRACTION
C                 MULTIPLICATION
C                 TRUNCATION
C
C                 NUMBER OF ROWS
C                 NUMBER OF COLUMNS
C                 ROW
C                 ELEMENT
C                 REPLACE ROW
C                 REPLACE ELEMENT
C                 DIAGONAL
C
C                 SOLUTION
C                 ITERATIVE SOLUTION
C                 TRIDIAGONAL SOLVE
C                 TRIANGULAR SOLVE
C                 SIMPLEX SOLUTION
C                 RANK
C
C                 INVERSE
C                 TRIANGULAR INVERSE
C                 DETERMINANT
C                 TRACE
C                 PERMANENT                    (NOT YET IMPLEMENED)
C                 ADJOINT
C                 SUBMATRIX
C                 MINOR
C                 COFACTOR
C
C                 DEFINITION
C                 AUGMENT
C                 TRANSPOSE
C
C                 CHARACTERISTIC EQUATION      (NOT YET IMPLEMENED)
C
C                 EIGENVALUES
C                 EIGENVECTORS
C                 SINGULAR VALUE
C                 SINGULAR VALUE DECOMPOSITION
C                 CHOLESKY DECOMPOSITION
C                 SPECTRAL NORM 
C                 SPECTRAL RADIUS
C                 EUCLIDEAN NORM 
C
C                 VARIANCE-COVARIANCE MATRIX
C                 CORRELATION MATRIX
C                 PRINCIPLE COMPONENTS ...
C                 ... PRINCIPLE COMPONENT ...
C
C     EXAMPLES--LET M3 = MATRIX ADDITION M1 M2
C               LET M3 = MATRIX ADDITION M1 P1
C             --LET M3 = MATRIX SUBTRACTION M1 M2
C               LET M3 = MATRIX SUBTRACTION M1 P1
C             --LET M3 = MATRIX MULTIPLICATION M1 M2
C               LET M3 = MATRIX MULTIPLICATION M1 V1
C               LET M3 = MATRIX MULTIPLICATION M1 P1
C             --LET V3 = MATRIX SOLUTION M1 V2
C             --LET V3 = MATRIX ITERATIVE SOLUTION M1 V2
C             --LET M3 = MATRIX INVERSE M1
C             --LET M3 = MATRIX TRANSPOSE M1
C             --LET M3 = MATRIX ADJOINT M1
C             --LET V3 = MATRIX CHARACTERISTIC EQUATION M1
C             --LET V3 = MATRIX EIGENVALUES M1
C             --LET P3 = MATRIX EIGENVECTORS M1
C             --LET P3 = MATRIX RANK M1
C             --LET P3 = MATRIX DETERMINANT M1
C             --LET P3 = MATRIX PERMANENT M1
C             --LET P3 = MATRIX SPECTRAL NORM M1
C             --LET P3 = MATRIX SPECTRAL RADIUS M1
C             --LET P3 = MATRIX NUMBER OF ROWS M1
C             --LET P3 = MATRIX NUMBER OF COLUMNS M1
C             --LET V4 = MATRIX SIMPLEX SOLUTION V1 M1 V2 V3
C             --LET P3 = MATRIX TRACE M1
C             --LET M3 = MATRIX SUBMATRIX M1 P1 P2
C             --LET P3 = MATRIX MINOR M1 P1 P2
C             --LET P3 = MATRIX COFACTOR M1 P1 P2
C             --LET M3 = MATRIX DEFINITION V1 P1 P2
C             --LET M3 = MATRIX DEFINITION V1 P1 P2 P3
C             --LET P3 = MATRIX EUCLIDEAN NORM M1
C             --LET V3 = MATRIX ROW M1 P1
C             --LET P3 = MATRIX ELEMENT M1 P1 P2
C             --LET M3 = MATRIX REPLACE ROW M1 V1 P1
C             --LET M3 = MATRIX REPLACE ELEMENT M1 P1 P2
C             --LET M3 = MATRIX AUGMENT M1
C             --LET V3 = MATRIX DIAGONAL M1
C             --LET M3 = DIAGONAL MATRIX V1
C             --LET M3 = VARIANCE-COVARIANCE MATRIX M1
C             --LET M3 = CORRELATION MATRIX M1
C             --LET M3 = PRINCIPLE COMPONENTS M1
C             --LET M3 = PRINCIPLE COMPONENTS EIGENVECTORS M1
C             --LET V3 = PRINCIPLE COMPONENTS EIGENVALUES M1
C             --LET V3 = ... PRINCIPLE COMPONENT M1
C             --LET V3 = ... PRINCIPLE COMPONENT EIGENVECTOR M1
C             --LET P3 = ... PRINCIPLE COMPONENT EIGENVALUE M1
C             --LET V3 = MATRIX SINGULAR VALUES M1
C             --LET M3 V3 M2 = MATRIX SINGULAR VALUE DECOMP M1
C             --LET M3 V3 M2 = MATRIX SINGULAR VALUE FACTOR M1
C             --LET M3 = CHOLESKY DECOMP M1
C             --LET V4 = TRIDIAGONAL SOLVE V1 V2 V3
C             --LET V4 = TRIANGULAR SOLVE M1 V2
C             --LET M3 = TRIANGULAR INVERSE M2
C             --LET M3 = MATRIX TRUNCATION M1 P1
C             --LET M3 = MATRIX UPPPER TRUNCATION M1 P1
C
C     INPUT  ARGUMENTS--YM1 (REAL MATRIX)
C                     --NR1
C                     --NC1
C                     --YM2 (REAL MATRIX)
C                     --NR2
C                     --NC2
C                     --YM3 (REAL MATRIX)
C                     --NR3
C                     --NC3
C                     --Y1  (REAL VECTOR)
C                     --N1
C                     --Y2  (REAL VECTOR)
C                     --N2
C                     --Y3  (REAL VECTOR)
C                     --N3
C                     --Y4  (REAL VECTOR)
C                     --N4
C     OUTPUT ARGUMENTS--YM9 (REAL MATRIX)
C                     --NR9
C                     --NC9
C                     --VECT9 (REAL VECTOR)
C                     --NVECT9
C                     --SCAL9 (REAL SCALAR)
C                     --ITYP9
C
C     NOTE--IT IS NOT PERMISSIBLE TO HAVE THE OUTPUT MATRIX YM9(.)
C           BEING IDENTICAL TO THE INPUT MATRIX YM1(.), YM2(.), OR YM3(.).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--SEPTEMBER 1987.
C     UPDATED         --AUGUST  1988  (VARIANCE-COVARIANCE MATRIX)
C     UPDATED         --AUGUST  1988  (CORRELATION MATRIX)
C     UPDATED         --AUGUST  1988  (PRINCIPLE COMPONENTS)
C     UPDATED         --AUGUST  1988  (... PRINCIPLE COMPONENTS)
C     UPDATED         --APRIL   1992  DEFINE D999
C     UPDATED         --JULY    1993  FOR MATRIX SOLUTION, DETERMINANT,
C                                     INVERSE, REPLACE NUMERICAL RECIPES
C                                     CODE WITH LINPACK CODE
C     UPDATED         --JULY    1993  EIGENVALUES AND EIGENVECTORS 
C                                     EXTENDED TO NON-SYMMETRIC CASE
C     UPDATED         --JULY    1993  IMPLEMENT RANK, ADJOINT, SINGULAR
C                                     VALUES, SINGULAR VALUE DECOMP.
C     UPDATED         --SEPT    1993  ROW, ELEMENT CASES
C     UPDATED         --OCTOBER 1993  CHOLESKY DECOMPOSITION, REPLACE 
C                                     ROW, REPLACE ELEMENT, AUGMENT,
C                                     DIAGONAL, ADD ARGUMENT TO
C                                     MATRIX DEFINITION, TRIDIAGONAL
C                                     SOLVE.
C     UPDATED         --OCTOBE R1993  MOVE SOME OPERATIONS TO MATAR2
C     UPDATED         --DECEMBER 1994 MATRIX SUBMATRIX FOR NON-SQUARE
C                                     MATRICES
C     UPDATED         --JUNE     1995 EXTEND SPECTRAL RADIUS TO 
C                                     NON-SYMMETRIC CASE
C     UPDATED         --JANUARY  1998 RECODE TO USE FEWER MATRICES
C     UPDATED         --JULY     2002 SUPPORT FOR DIFFERENT TYPES OF
C                                     COVARIANCE AND CORRELATION MATRIX
C     UPDATED         --NOVEMBER 2004 SUPPORT FOR DIFFERENT TYPES OF
C     UPDATED         --MARCH    2006 MATRIX <LOWER/UPPER> TRUNCATE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMCASE
      CHARACTER*4 IUPFLG
      CHARACTER*4 IMSUBC
      CHARACTER*4 PCCASE
      CHARACTER*4 ITYPA1
      CHARACTER*4 ITYPA2
      CHARACTER*4 ITYPA3
      CHARACTER*4 ITYPA4
      CHARACTER*4 IWRITE
      CHARACTER*4 ITYP9
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C-----DOUBLE PRECISION STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DYM1
      DOUBLE PRECISION DYM2
      DOUBLE PRECISION DYM9
      DOUBLE PRECISION DSUM
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
CCCCC DOUBLE PRECISION DSUM12
      DOUBLE PRECISION DDEL
CCCCC DOUBLE PRECISION DARG1
CCCCC DOUBLE PRECISION DARG2
      DOUBLE PRECISION DPROD
C
      DOUBLE PRECISION DNR1
      DOUBLE PRECISION DNC1
      DOUBLE PRECISION DMEAN
      DOUBLE PRECISION DSSQD
      DOUBLE PRECISION DDENOM
      DOUBLE PRECISION DDEL1
      DOUBLE PRECISION DDEL2
      DOUBLE PRECISION DCOV
      DOUBLE PRECISION DCORR
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      DOUBLE PRECISION D999
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION YM1(MAXROM,MAXCOM)
      DIMENSION YM2(MAXROM,MAXCOM)
CCCCC DIMENSION YM3(MAXROM,MAXCOM)
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION Y4(*)
      DIMENSION YM9(MAXROM,MAXCOM)
      DIMENSION VECT9(*)
C
CCCCC DIMENSION YMJUNK(MAXROM,MAXCOM)
CCCCC DIMENSION YMJUN2(MAXROM,MAXCOM)
CCCCC JANUARY 1998.  FOLLOWINF DIMENSIONS TO MAXOBV.
CCCCC DIMENSION INDEX(MAXROM)
CCCCC DIMENSION VJUNK(MAXROM)
CCCCC DIMENSION VJUNK2(MAXROM)
CCCCC DIMENSION AINDE2(MAXROM)
CCCCC DIMENSION AINDE3(MAXROM)
C
CCCCC DIMENSION IZROV(MAXROM)
CCCCC DIMENSION IPOSV(MAXROM)
C
CCCCC DIMENSION DMEAN(MAXROM)
CCCCC DIMENSION DSSQD(MAXROM)
C
CCCCC DIMENSION INDEX(MAXOBV)
      DIMENSION INDEX(*)
CCCCC REPLACE VJUNK, VJUNK2 WITH Y3 AND Y4 BELOW (TO SAVE SPACE)
CCCCC DIMENSION VJUNK(MAXOBV)
CCCCC DIMENSION VJUNK2(MAXOBV)
CCCCC REPLACE AINDE2, AINDE3 WITH Y1 AND Y2 BELOW (TO SAVE SPACE)
CCCCC DIMENSION AINDE2(MAXOBV)
CCCCC DIMENSION AINDE3(MAXOBV)
C
CCCCC DIMENSION IZROV(MAXOBV)
CCCCC DIMENSION IPOSV(MAXOBV)
      DIMENSION IZROV(*)
      DIMENSION IPOSV(*)
C
CCCCC DIMENSION DMEAN(MAXOBV)
CCCCC DIMENSION DSSQD(MAXOBV)
      DIMENSION DMEAN(*)
      DIMENSION DSSQD(*)
C
C---------------------------------------------------------------------
C
CCCCC JULY 1993.  ADD FOLLOWING COMMON BLOCK FOR PRINCIPLE COMPONENTS
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
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
CCCCC JULY 1993.  FOLLOWING LINE ADDED FOR RANK.
      DATA RMXINT /134217727. /
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='MATA'
      ISUBN2='RI  '
C
      IERROR='NO'
C
CCCCC JULY 1993.  
CCCCC PCCASE='DACR'
      PCCASE=IPCMTY
C
      IYS1=(-999)
      IYS2=(-999)
      IYS3=(-999)
      IYS23=(-999)
C
      NRJ=(-999)
      NCJ=(-999)
C
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      D999=(-999.0D0)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'TARI')GOTO190
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4
   52 FORMAT('IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMCASE,IMSUBC
   53 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMVAR,IWRITE
   54 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)YS1,YS2,YS3,YS4
   55 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NR1,NC1
   61 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO69
      IF(NC1.LE.0)GOTO69
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO62I=1,NR1
      WRITE(ICOUT,63)I,(YM1(I,J),J=1,JMAX)
   63 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   69 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)NR2,NC2
   71 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO79
      IF(NC2.LE.0)GOTO79
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO72I=1,NR2
      WRITE(ICOUT,73)I,(YM2(I,J),J=1,JMAX)
   73 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   79 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NR3,NC3
   81 FORMAT('NR3,NC3 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR3.LE.0)GOTO89
      IF(NC3.LE.0)GOTO89
      JMAX=NC3
      IF(JMAX.GT.10)JMAX=10
      DO82I=1,NR3
      WRITE(ICOUT,83)I,(YM9(I,J),J=1,JMAX)
   83 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   89 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)N1
  111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO119
      DO112I=1,N1
      WRITE(ICOUT,113)I,Y1(I)
  113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  112 CONTINUE
  119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)N2
  121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO129
      DO122I=1,N2
      WRITE(ICOUT,123)I,Y2(I)
  123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  122 CONTINUE
  129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)N3
  131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO139
      DO132I=1,N3
      WRITE(ICOUT,133)I,Y3(I)
  133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  132 CONTINUE
  139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)N4
  141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO149
      DO142I=1,N4
      WRITE(ICOUT,143)I,Y4(I)
  143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  142 CONTINUE
  149 CONTINUE
C
  190 CONTINUE
C
C               **************************************************
C               **  CARRY OUT MATRIX     ARITHMETIC OPERATIONS  **
C               **************************************************
C
      DNR1=NR1
      DNC1=NC1
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK NUMBER OF INPUT OBSERVATIONS.   **
C               ********************************************
C
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NR1.LE.0)GOTO1100
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NC1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NR2.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NC2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NR3.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NC3.LE.0)GOTO1100
C
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1.AND.N1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2.AND.N2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3.AND.N3.LE.0)GOTO1100
C
      GOTO1190
C
 1100 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE INPUT NUMBER OF ROWS AND/OR COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      IN THE MATRIX AND/OR VECTOR FOR WHICH')
      CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAAD')WRITE(ICOUT,1121)
 1121 FORMAT('      THE MATRIX     ADDITION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAAD')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MASU')WRITE(ICOUT,1122)
 1122 FORMAT('      THE MATRIX     SUBTRACTION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MASU')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAMU')WRITE(ICOUT,1123)
 1123 FORMAT('      THE MATRIX     MULTIPLICATION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAMU')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MASO')WRITE(ICOUT,1124)
 1124 FORMAT('      THE MATRIX     SOLUTION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MASO')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAIN')WRITE(ICOUT,1125)
 1125 FORMAT('      THE MATRIX     INVERSE IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAIN')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MATR')WRITE(ICOUT,1126)
 1126 FORMAT('      THE MATRIX     TRANSPOSE IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MATR')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAAJ')WRITE(ICOUT,1127)
 1127 FORMAT('      THE MATRIX     ADJOINT IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAAJ')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MACE')WRITE(ICOUT,1128)
 1128 FORMAT('      THE MATRIX CHARACTERISTIC EQUATION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MACE')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAEA')WRITE(ICOUT,1129)
 1129 FORMAT('      THE MATRIX     EIGENVALUES ARE TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAEA')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAEE')WRITE(ICOUT,1130)
 1130 FORMAT('      THE MATRIX     EIGENVECTORS ARE TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAEE')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MARA')WRITE(ICOUT,1131)
 1131 FORMAT('      THE MATRIX     RANK IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MARA')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MADE')WRITE(ICOUT,1132)
 1132 FORMAT('      THE MATRIX     DETERMINANT IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MADE')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAPE')WRITE(ICOUT,1133)
 1133 FORMAT('      THE MATRIX     PERMANENT IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAPE')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MASN')WRITE(ICOUT,1134)
 1134 FORMAT('      THE MATRIX     SPECTRAL NORM IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MASN')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MASR')WRITE(ICOUT,1135)
 1135 FORMAT('      THE MATRIX     SPECTRAL RADIUS IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MASR')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MANR')WRITE(ICOUT,1136)
 1136 FORMAT('      THE MATRIX     NUMBER OF ROWS IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MANR')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MANC')WRITE(ICOUT,1137)
 1137 FORMAT('      THE MATRIX     NUMBER OF COLUMNS IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MANC')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MANC')WRITE(ICOUT,1138)
 1138 FORMAT('      THE MATRIX     SIMPLEX SOLUTION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MANC')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MATC')WRITE(ICOUT,1141)
 1141 FORMAT('      THE MATRIX     TRACE IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MATC')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MASM')WRITE(ICOUT,1142)
 1142 FORMAT('      THE MATRIX     SUBMATRIX IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MASM')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAMI')WRITE(ICOUT,1143)
 1143 FORMAT('      THE MATRIX     MINOR IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAMI')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MACF')WRITE(ICOUT,1144)
 1144 FORMAT('      THE MATRIX     COFACTOR IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MACF')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MADF')WRITE(ICOUT,1145)
 1145 FORMAT('      THE MATRIX     DEFINITION IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MADF')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAEN')WRITE(ICOUT,1146)
 1146 FORMAT('      THE MATRIX     EUCLIDEAN NORM IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAEN')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAVC')WRITE(ICOUT,1151)
 1151 FORMAT('      THE VARIANCE-COVARIANCE MATRIX IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAVC')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MACO')WRITE(ICOUT,1152)
 1152 FORMAT('      THE CORRELATION MATRIX IS TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MACO')CALL DPWRST('XXX','BUG ')
      IF(IMCASE.EQ.'MAPC')WRITE(ICOUT,1153)
 1153 FORMAT('      THE PRINCIPLE COMPONENTS ARE TO BE ',
     1'COMPUTED')
      IF(IMCASE.EQ.'MAPC')CALL DPWRST('XXX','BUG ')
      IF(IMCASE(1:3).EQ.'MAP'.AND.IMCASE(4:4).NE.'C')THEN
         WRITE(ICOUT,1154)
 1154    FORMAT('      THE ... PRINCIPLE COMPONENT TO BE ',
     1   'COMPUTED')
         CALL DPWRST('XXX','BUG ')
      ENDIF
      WRITE(ICOUT,1181)
 1181 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1)WRITE(ICOUT,1183)NR1,NC1
 1183 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1)CALL DPWRST('XXX','BUG ')
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2)WRITE(ICOUT,1184)NR2,NC2
 1184 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2)CALL DPWRST('XXX','BUG ')
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3)WRITE(ICOUT,1185)NR3,NC3
 1185 FORMAT('            MATRIX 3--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3)CALL DPWRST('XXX','BUG ')
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1)WRITE(ICOUT,1186)N1
 1186 FORMAT('            VECTOR 1--',I8,' ROWS')
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1)CALL DPWRST('XXX','BUG ')
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2)WRITE(ICOUT,1187)N2
 1187 FORMAT('            VECTOR 2--',I8,' ROWS')
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2)CALL DPWRST('XXX','BUG ')
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3)WRITE(ICOUT,1188)N3
 1188 FORMAT('            VECTOR 3--',I8,' ROWS')
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3)CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1190 CONTINUE
C
C               *********************************
C               **  STEP 12--                  **
C               **  BRANCH TO THE PROPER CASE  **
C               *********************************
C
      IF(IMCASE.EQ.'MAAD')GOTO2100
      IF(IMCASE.EQ.'MASU')GOTO2200
      IF(IMCASE.EQ.'MAMU')GOTO2300
      IF(IMCASE.EQ.'MASO')GOTO2400
      IF(IMCASE.EQ.'MAIN')GOTO2500
      IF(IMCASE.EQ.'MATR')GOTO2600
      IF(IMCASE.EQ.'MAAJ')GOTO2700
      IF(IMCASE.EQ.'MACE')GOTO2800
      IF(IMCASE.EQ.'MAEA')GOTO2900
      IF(IMCASE.EQ.'MAEE')GOTO3000
      IF(IMCASE.EQ.'MARA')GOTO3100
      IF(IMCASE.EQ.'MADE')GOTO3200
      IF(IMCASE.EQ.'MAPE')GOTO3300
      IF(IMCASE.EQ.'MASN')GOTO3400
      IF(IMCASE.EQ.'MASR')GOTO3500
      IF(IMCASE.EQ.'MANR')GOTO3600
      IF(IMCASE.EQ.'MANC')GOTO3700
      IF(IMCASE.EQ.'MASS')GOTO3800
      IF(IMCASE.EQ.'MATC')GOTO4100
      IF(IMCASE.EQ.'MASM')GOTO4200
      IF(IMCASE.EQ.'MAMI')GOTO4300
      IF(IMCASE.EQ.'MACF')GOTO4400
      IF(IMCASE.EQ.'MADF')GOTO4500
      IF(IMCASE.EQ.'MAEN')GOTO4600
      IF(IMCASE.EQ.'MAVC')GOTO5100
      IF(IMCASE.EQ.'MACO')GOTO5200
C
      IF(IMCASE.EQ.'MAPC')GOTO5300
      IF(IMCASE.EQ.'MAP1')GOTO5300
      IF(IMCASE.EQ.'MAP2')GOTO5300
      IF(IMCASE.EQ.'MAP3')GOTO5300
      IF(IMCASE.EQ.'MAP4')GOTO5300
      IF(IMCASE.EQ.'MAP5')GOTO5300
      IF(IMCASE.EQ.'MAP6')GOTO5300
      IF(IMCASE.EQ.'MAP7')GOTO5300
      IF(IMCASE.EQ.'MAP8')GOTO5300
      IF(IMCASE.EQ.'MAP9')GOTO5300
      IF(IMCASE.EQ.'MA10')GOTO5300
CCCCCC OCTOBER 1993.  FOLLOWING OPERATIONS MOVED TO MATAR2
CCCCC JULY 1993.  ADD FOLLOWING 3 LINES
CCCCC IF(IMCASE.EQ.'MASV')GOTO5800
CCCCC IF(IMCASE.EQ.'MASD')GOTO5900
CCCCC IF(IMCASE.EQ.'MASF')GOTO6000
CCCCC SEPTEMBER 1993.  ADD FOLLOWING 2 LINES
CCCCC IF(IMCASE.EQ.'MARW')GOTO6100
CCCCC IF(IMCASE.EQ.'MAEL')GOTO6200
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
CCCCC IF(IMCASE.EQ.'MACH')GOTO6300
CCCCC IF(IMCASE.EQ.'MAAU')GOTO6400
CCCCC IF(IMCASE.EQ.'MADI')GOTO6500
CCCCC IF(IMCASE.EQ.'DIMA')GOTO6600
CCCCC IF(IMCASE.EQ.'MARR')GOTO6700
CCCCC IF(IMCASE.EQ.'MARE')GOTO6800
CCCCC IF(IMCASE.EQ.'MATD')GOTO6900
CCCCC IF(IMCASE.EQ.'MATS')GOTO7000
CCCCC IF(IMCASE.EQ.'MATI')GOTO7100
CCCCC IF(IMCASE.EQ.'MAIS')GOTO7200
C
      IF(IMCASE.EQ.'MATZ')GOTO6100
      IF(IMCASE.EQ.'MAUZ')GOTO6200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** INTERNAL ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      IMCASE NOT EQUAL TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      MAAD, MASU, MAMU, MASO, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      MAIN, MATR, MAAJ, MACE, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      MAEA, MAEE, MARA, MADE, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      MAPE, MASN, MASR, MANR, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      MANC, MASS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1221)
 1221 FORMAT('      MAVC, MACO, MAPC, OR MAPX ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1228)IMCASE
 1228 FORMAT('      IMCASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *********************************************
C               **  STEP 21--                              **
C               **  TREAT THE MATRIX     ADDITION    CASE  **
C               *********************************************
C
 2100 CONTINUE
C
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'MATR')GOTO2110
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'VARI')GOTO2130
      IF(ITYPA1.EQ.'VARI'.AND.ITYPA2.EQ.'MATR')GOTO2150
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'PARA')GOTO2170
      IF(ITYPA1.EQ.'PARA'.AND.ITYPA2.EQ.'MATR')GOTO2180
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2101)
 2101 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2102)
 2102 FORMAT('      ILLEGAL ARGUMENT TYPES FOR MATRIX ADDITION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2103)ITYPA1
 2103 FORMAT('            TYPE FOR ARGUMENT 1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2104)ITYPA2
 2104 FORMAT('            TYPE FOR ARGUMENT 2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2110 CONTINUE
      IF(NR1.EQ.NR2.AND.NC1.EQ.NC2)GOTO2119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2112)
 2112 FORMAT('      FOR MATRIX ADDITION OF MATRIX 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)
 2116 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)NR1,NC1
 2117 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2118)NR2,NC2
 2118 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2119 CONTINUE
C
C
 2120 CONTINUE
      DO2121I=1,NR1
      DO2122J=1,NC1
      DYM1=YM1(I,J)
      DYM2=YM2(I,J)
      DYM9=DYM1+DYM2
      YM9(I,J)=DYM9
 2122 CONTINUE
 2121 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      GOTO9000
C
 2130 CONTINUE
      IF(NR1.EQ.N2)GOTO2139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2131)
 2131 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2132)
 2132 FORMAT('      FOR MATRIX ADDITION OF MATRIX 1 & VECTOR 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2133)
 2133 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2134)
 2134 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2135)
 2135 FORMAT('      THE NUMBER OF ROWS IN VECTOR 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2136)
 2136 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2137)NR1,NC1
 2137 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2138)N2
 2138 FORMAT('            VECTOR 2--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2139 CONTINUE
C
 2140 CONTINUE
      DO2141I=1,NR1
      DYM2=Y2(I)
      DO2142J=1,NC1
      DYM1=YM1(I,J)
      DYM9=DYM1+DYM2
      YM9(I,J)=DYM9
 2142 CONTINUE
 2141 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 2150 CONTINUE
      IF(N1.EQ.NR2)GOTO2159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2151)
 2151 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2152)
 2152 FORMAT('      FOR MATRIX ADDITION OF VECTOR 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2153)
 2153 FORMAT('      THE NUMBER OF ROWS IN VECTOR 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2154)
 2154 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2155)
 2155 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2156)
 2156 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2157)N1
 2157 FORMAT('            VECTOR 1--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2158)NR2,NC2
 2158 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2159 CONTINUE
C
 2160 CONTINUE
      DO2161I=1,NR2
      DYM1=Y1(I)
      DO2162J=1,NC2
      DYM2=YM2(I,J)
      DYM9=DYM1+DYM2
      YM9(I,J)=DYM9
 2162 CONTINUE
 2161 CONTINUE
      ITYP9='MATR'
      NR9=NR2
      NC9=NC2
      GOTO9000
C
 2170 CONTINUE
      DYM2=YS2
      DO2171I=1,NR1
      DO2172J=1,NC1
      DYM1=YM1(I,J)
      DYM9=DYM1+DYM2
      YM9(I,J)=DYM9
 2172 CONTINUE
 2171 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 2180 CONTINUE
      DYM1=YS1
      DO2181I=1,NR2
      DO2182J=1,NC2
      DYM2=YM2(I,J)
      DYM9=DYM1+DYM2
      YM9(I,J)=DYM9
 2182 CONTINUE
 2181 CONTINUE
      ITYP9='MATR'
      NR9=NR2
      NC9=NC2
      IUPFLG='SUBS'
      GOTO9000
C
C               *********************************************
C               **  STEP 22--                              **
C               **  TREAT THE MATRIX     SUBTRACTION CASE  **
C               *********************************************
C
 2200 CONTINUE
C
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'MATR')GOTO2210
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'VARI')GOTO2230
      IF(ITYPA1.EQ.'VARI'.AND.ITYPA2.EQ.'MATR')GOTO2250
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'PARA')GOTO2270
      IF(ITYPA1.EQ.'PARA'.AND.ITYPA2.EQ.'MATR')GOTO2280
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      ILLEGAL ARGUMENT TYPES FOR MATRIX SUBTRACTION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)ITYPA1
 2203 FORMAT('            TYPE FOR ARGUMENT 1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)ITYPA2
 2204 FORMAT('            TYPE FOR ARGUMENT 2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2210 CONTINUE
      IF(NR1.EQ.NR2.AND.NC1.EQ.NC2)GOTO2219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      FOR MATRIX SUBTRACTION OF MATRIX 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2217)NR1,NC1
 2217 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2218)NR2,NC2
 2218 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2219 CONTINUE
C
C
 2220 CONTINUE
      DO2221I=1,NR1
      DO2222J=1,NC1
      DYM1=YM1(I,J)
      DYM2=YM2(I,J)
      DYM9=DYM1-DYM2
      YM9(I,J)=DYM9
 2222 CONTINUE
 2221 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 2230 CONTINUE
      IF(NR1.EQ.N2)GOTO2239
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2231)
 2231 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2232)
 2232 FORMAT('      FOR MATRIX SUBTRACTION OF MATRIX 1 & VECTOR 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2233)
 2233 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2234)
 2234 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2235)
 2235 FORMAT('      THE NUMBER OF ROWS IN VECTOR 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2236)
 2236 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2237)NR1,NC1
 2237 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2238)N2
 2238 FORMAT('            VECTOR 2--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2239 CONTINUE
C
 2240 CONTINUE
      DO2241I=1,NR1
      DYM2=Y2(I)
      DO2242J=1,NC1
      DYM1=YM1(I,J)
      DYM9=DYM1-DYM2
      YM9(I,J)=DYM9
 2242 CONTINUE
 2241 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 2250 CONTINUE
      IF(N1.EQ.NR2)GOTO2259
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2251)
 2251 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2252)
 2252 FORMAT('      FOR MATRIX SUBTRACTION OF VECTOR 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2253)
 2253 FORMAT('      THE NUMBER OF ROWS IN VECTOR 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2254)
 2254 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2255)
 2255 FORMAT('      THE NUMBER OF ROWS AND COLUMNS IN MATRIX 2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2256)
 2256 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2257)N1
 2257 FORMAT('            VECTOR 1--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2258)NR2,NC2
 2258 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2259 CONTINUE
C
 2260 CONTINUE
      DO2261I=1,NR2
      DYM1=Y1(I)
      DO2262J=1,NC2
      DYM2=YM2(I,J)
      DYM9=DYM1-DYM2
      YM9(I,J)=DYM9
 2262 CONTINUE
 2261 CONTINUE
      ITYP9='MATR'
      NR9=NR2
      NC9=NC2
      IUPFLG='SUBS'
      GOTO9000
C
 2270 CONTINUE
      DYM2=YS2
      DO2271I=1,NR1
      DO2272J=1,NC1
      DYM1=YM1(I,J)
      DYM9=DYM1-DYM2
      YM9(I,J)=DYM9
 2272 CONTINUE
 2271 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 2280 CONTINUE
      DYM1=YS1
      DO2281I=1,NR2
      DO2282J=1,NC2
      DYM2=YM2(I,J)
      DYM9=DYM1-DYM2
      YM9(I,J)=DYM9
 2282 CONTINUE
 2281 CONTINUE
      ITYP9='MATR'
      NR9=NR2
      NC9=NC2
      IUPFLG='SUBS'
      GOTO9000
C
C               *********************************************
C               **  STEP 23--                              **
C               **  TREAT THE MATRIX  MULTIPLICATION CASE  **
C               *********************************************
C
 2300 CONTINUE
C
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'MATR')GOTO2310
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'VARI')GOTO2330
      IF(ITYPA1.EQ.'VARI'.AND.ITYPA2.EQ.'MATR')GOTO2350
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'PARA')GOTO2370
      IF(ITYPA1.EQ.'PARA'.AND.ITYPA2.EQ.'MATR')GOTO2380
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2301)
 2301 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('      ILLEGAL ARGUMENT TYPES FOR MATRIX MULTIPLIC.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2303)ITYPA1
 2303 FORMAT('            TYPE FOR ARGUMENT 1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2304)ITYPA2
 2304 FORMAT('            TYPE FOR ARGUMENT 2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2310 CONTINUE
      IF(NC1.EQ.NR2)GOTO2319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      FOR MATRIX MULTIPLIC. OF MATRIX 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      THE NUMBER OF COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)
 2315 FORMAT('      THE NUMBER OF ROWS    IN MATRIX 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)NR1,NC1
 2317 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2318)NR2,NC2
 2318 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2319 CONTINUE
C
 2320 CONTINUE
      DO2321I=1,NR1
      DO2322J=1,NC2
      DSUM=0.0D0
      DO2323K=1,NC1
      DYM1=YM1(I,K)
      DYM2=YM2(K,J)
      DYM9=DYM1*DYM2
      DSUM=DSUM+DYM9
 2323 CONTINUE
      YM9(I,J)=DSUM
 2322 CONTINUE
 2321 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC2
      IUPFLG='FULL'
      GOTO9000
C
 2330 CONTINUE
      IF(NC1.EQ.N2)GOTO2339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2331)
 2331 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2332)
 2332 FORMAT('      FOR MATRIX MULTIPLIC. OF MATRIX 1 & VECTOR 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2333)
 2333 FORMAT('      THE NUMBER OF COLUMNS IN MATRIX 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2334)
 2334 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2335)
 2335 FORMAT('      THE NUMBER OF ROWS IN VECTOR 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2336)
 2336 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2337)NR1,NC1
 2337 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2338)N2
 2338 FORMAT('            VECTOR 2--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2339 CONTINUE
C
 2340 CONTINUE
      DO2341I=1,NR1
      J=1
      DSUM=0.0D0
      DO2343K=1,NC1
      DYM1=YM1(I,K)
      DYM2=Y2(K)
      DYM9=DYM1*DYM2
      DSUM=DSUM+DYM9
 2343 CONTINUE
      VECT9(I)=DSUM
 2342 CONTINUE
 2341 CONTINUE
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='FULL'
      GOTO9000
C
 2350 CONTINUE
      IF(1.EQ.NR2)GOTO2359
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2351)
 2351 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2352)
 2352 FORMAT('      FOR MATRIX MULTIPLIC. OF VECTOR 1 & MATRIX 2,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2355)
 2355 FORMAT('      THE NUMBER OF ROWS IN MATRIX 2 MUST = 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2356)
 2356 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2358)NR2,NC2
 2358 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2359 CONTINUE
C
 2360 CONTINUE
      DO2361I=1,NR1
      DO2362J=1,NC2
      DSUM=0.0D0
      K=1
      DYM1=Y1(I)
      DYM2=YM2(K,J)
      DYM9=DYM1*DYM2
      DSUM=DSUM+DYM9
 2363 CONTINUE
      YM9(I,J)=DSUM
 2362 CONTINUE
 2361 CONTINUE
      ITYP9='MATR'
      NR9=N1
      NC9=NC2
      IUPFLG='FULL'
      GOTO9000
C
 2370 CONTINUE
      DYM2=YS2
      DO2371I=1,NR1
      DO2372J=1,NC1
      DYM1=YM1(I,J)
      DYM9=DYM1*DYM2
      YM9(I,J)=DYM9
 2372 CONTINUE
 2371 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 2380 CONTINUE
      DYM1=YS1
      DO2381I=1,NR2
      DO2382J=1,NC2
      DYM2=YM2(I,J)
      DYM9=DYM1*DYM2
      YM9(I,J)=DYM9
 2382 CONTINUE
 2381 CONTINUE
      ITYP9='MATR'
      NR9=NR2
      NC9=NC2
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 24--                              **
C               **  TREAT THE MATRIX     SOLUTION    CASE  **
C               **  REFERENCE--PRESS ET AL, PAGE 37        **
C               *********************************************
C
 2400 CONTINUE
C
      IF(NR1.EQ.N2)GOTO2409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2401)
 2401 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2402)
 2402 FORMAT('      FOR SOLVING A MATRIX EQUATION SUCH AS A*X = B,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2403)
 2403 FORMAT('      THE NUMBER OF ROWS IN THE LEFT-SIDE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2404)
 2404 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2405)
 2405 FORMAT('      THE NUMBER OF ROWS IN THE RIGHT-SIDE VECTOR;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2406)
 2406 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2407)NR1
 2407 FORMAT('              NUMBER OF ROWS IN THE MATRIX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2408)N2
 2408 FORMAT('              NUMBER OF ROWS IN THE VECTOR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2409 CONTINUE
C
      DO2451I=1,N2
CCCCC VECT9(I)=YM2(1,I)
CCCCC VECT9(I)=YM2(I,1)
      VECT9(I)=Y2(I)
 2451 CONTINUE
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH LINPACK 
CCCCC ALGORITHM.  
CCCCC CALL LUDCMP(YMJUNK,NR1,MAXROM,INDEX,DP1M1)
CCCCC CALL LUBKSB(YMJUNK,NR1,MAXROM,INDEX,VECT9)
      CALL SGECO(YM1,MAXROM,NR1,INDEX,RCOND,Y3)
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2461)RCOND
        CALL DPWRST('XXX','TEXT ')
      ENDIF
 2461 FORMAT('THE RECIPROCAL CONDITION NUMBER FOR THE MATRIX = ',E15.7)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2471)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,2472)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      ELSE
        IJOB=0
        CALL SGESL(YM1,MAXROM,NR1,INDEX,VECT9,IJOB)
      END IF
 2471 FORMAT('****** ERROR IN MATARI ********')
 2472 FORMAT('       THE INPUT MATRIX IS SINGULAR')
CCCCC END CHANGE
C
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 25--                              **
C               **  TREAT THE MATRIX     INVERSE     CASE  **
C               **  REFERENCE--PRESS ET AL, PAGE 38        **
C               *********************************************
C
 2500 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO2509
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2501)
 2501 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2502)
 2502 FORMAT('      FOR MATRIX INVERSE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2503)
 2503 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2504)
 2504 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2505)
 2505 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2506)
 2506 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2507)NR1
 2507 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2508)NC1
 2508 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2509 CONTINUE
C
      DO2511I=1,NR1
      DO2512J=1,NC1
      YM9(I,J)=0.0
 2512 CONTINUE
      YM9(I,I)=1.0
 2511 CONTINUE
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH LINPACK
CCCCC ALGORITHM.
C
CCCCC CALL LUDCMP(YMJUNK,NR1,MAXROM,INDEX,DP1M1)
C
CCCCC DO2521J=1,NR1
CCCCC CALL LUBKSB(YMJUNK,NR1,MAXROM,INDEX,YM9(1,J))
C2521 CONTINUE
      CALL SGECO(YM1,MAXROM,NR1,INDEX,RCOND,Y3)
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2561)RCOND
        CALL DPWRST('XXX','TEXT ')
      ENDIF
 2561 FORMAT('THE RECIPROCAL CONDITION NUMBER FOR THE MATRIX = ',E15.7)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2571)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,2572)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      ELSE
        IJOB=1
        CALL SGEDI(YM1,MAXROM,NR1,INDEX,Y3,Y4,IJOB)
        DO2581J=1,NC1
        DO2582I=1,NR1
        YM9(I,J)=YM1(I,J)
 2582   CONTINUE
 2581   CONTINUE
      END IF
 2571 FORMAT('****** ERROR IN MATARI ********')
 2572 FORMAT('       THE INPUT MATRIX IS SINGULAR')
CCCCC END CHANGE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 26--                              **
C               **  TREAT THE MATRIX     TRANSPOSE   CASE  **
C               *********************************************
C
 2600 CONTINUE
C
      IF(NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2601)
 2601   FORMAT('***** ERROR IN MATARI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2603)NR1
 2603   FORMAT('      THE NUMBER OF ROWS IN THE MATRIX,',I5,
     1         'EXCEEDS THE MAXIMUM')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2605)MAXCOM
 2605   FORMAT('      NUMBER OF COLUMNS FOR A MATRIX,',I5,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2607)
 2607   FORMAT('      THE MATRIX TRANSPOSE WAS NOT COMPUTED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO2611I=1,NR1
      DO2612J=1,NC1
      YM9(J,I)=YM1(I,J)
 2612 CONTINUE
 2611 CONTINUE
C
      ITYP9='MATR'
      NR9=NC1
      NC9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 27--                              **
C               **  TREAT THE MATRIX     ADJOINT     CASE  **
C               *********************************************
CCCCC JULY 1993.  IMPLENENT THIS COMMAND.  NOTE THAT THE CLASSICAL
CCCCC ADJOINT IS ESSENTIALLY THE MATRIX CONTAINING THE COFACTORS 
CCCCC FOR EACH ELEMENT.  THIS CALCULATES THE DETERMINANT AT 
CCCCC EACH MATRIX SUB-ELEMENT, SO CAN GET TIME-CONSUMING FOR LARGE
CCCCC MATRICES.
C
 2700 CONTINUE
C
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2711)
C2711 FORMAT('***** ERROR IN MATARI--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2712)
C2712 FORMAT('      THE MATRIX ADJOINT COMMAND')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2713)
C2713 FORMAT('      IS NOT YET IMPLEMENTED.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
C
      IF(NR1.EQ.NC1)GOTO2709
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2701)
 2701 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2702)
 2702 FORMAT('      FOR MATRIX ADJOINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2703)
 2703 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2704)
 2704 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2705)
 2705 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2706)
 2706 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2707)NR1
 2707 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2708)NC1
 2708 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2709 CONTINUE
C
      DO2790IROWID=1,NR1
      IYS2=IROWID
      DO2780ICOLID=1,NC1
      IYS3=ICOLID
      I2=0
      J2=0
      DO2711I=1,NR1
      IF(I.EQ.IYS2)GOTO2711
      I2=I2+1
      NRJ=I2
      J2=0
      DO2712J=1,NC1
      IF(J.EQ.IYS3)GOTO2712
      J2=J2+1
      NCJ=J2
      YM2(I2,J2)=YM1(I,J)
 2712 CONTINUE
 2711 CONTINUE
C
      IF(NRJ.GE.1.AND.NCJ.GE.1)GOTO2729
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2721)
 2721 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2722)
 2722 FORMAT('      FOR MATRIX COFACTOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2723)
 2723 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2724)
 2724 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2725)
 2725 FORMAT('      MUST BOTH BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2726)
 2726 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2727)NRJ
 2727 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2728)NCJ
 2728 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2729 CONTINUE
C
      IF(NRJ.EQ.NCJ)GOTO2739
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2731)
 2731 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2732)
 2732 FORMAT('      FOR MATRIX ADJOINT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2733)
 2733 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2734)
 2734 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2735)
 2735 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2736)
 2736 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2737)NRJ
 2737 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2738)NCJ
 2738 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2739 CONTINUE
C
      CALL SGECO(YM2,MAXROM,NRJ,INDEX,RCOND,Y3)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2771)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,2772)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,2773)IROWID,ICOLID
        CALL DPWRST('XXX','ERRO ')
        COFACT=0.0
        IERROR='YES'
      ELSE
        IJOB=10
        CALL SGEDI(YM2,MAXROM,NRJ,INDEX,Y3,Y4,IJOB)
        DET=Y3(1)*10.0**Y3(2)
        COFACT=DET
        IYS23=IYS2+IYS3
        IREM=IYS23-2*(IYS23/2)
        IF(IREM.EQ.1)COFACT=(-COFACT)
      END IF
 2771 FORMAT('****** ERROR IN MATARI ********')
 2772 FORMAT('       UNABLE TO COMPUTE THE DETERMINANT FOR')
 2773 FORMAT('       ROW ',I4,' AND COLUMN ',I4)
CCCCC END CHANGE
C
      YM9(IROWID,ICOLID)=COFACT
 2780 CONTINUE
 2790 CONTINUE
C
      ITYP9='MATR'
      NC9=NR1
      NR9=NR1
      SCAL9=COFACT
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 28--                                        **
C               **  TREAT THE MATRIX CHARACTERISTIC EQUATION   CASE  **
C               *******************************************************
C
 2800 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2811)
 2811 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2812)
 2812 FORMAT('      THE MATRIX CHARACTERISTIC EQUATION COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2813)
 2813 FORMAT('      IS NOT YET IMPLEMENTED.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C
C               *********************************************
C               **  STEP 29--                              **
C               **  TREAT THE MATRIX     EIGENVALUES CASE  **
C               *********************************************
C
 2900 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO2909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2901)
 2901 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2902)
 2902 FORMAT('      FOR MATRIX EIGENVALUES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2903)
 2903 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2904)
 2904 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2905)
 2905 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2906)
 2906 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2907)NR1
 2907 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2908)NC1
 2908 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2909 CONTINUE
C
      DO2911I=1,NR1
      I2=I
      DO2912J=I,NC1
      J2=J
      YM1IJ=YM1(I,J)
      YM1JI=YM1(J,I)
      IF(YM1IJ.EQ.YM1JI)GOTO2912
      GOTO2930
 2912 CONTINUE
 2911 CONTINUE
      GOTO2939
C
CCCCC JULY 1993.  ADD SUPPORT FOR NON-SYMMETRIC CASE.  THIS CASE
CCCCC CAN HAVE COMPLEX EIGENVALUES.  ROWS 1 THROUGH N OF THE OUTPUT
CCCCC VECTOR WILL CONTAIN THE REAL COMPONENT, ROWS N+1 THROUGH 2*N 
CCCCC WILL CONTAIN THE COMPLEX COMPONENT.
 2930 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2931)
C2931 FORMAT('***** ERROR IN MATARI--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2932)
C2932 FORMAT('      FOR MATRIX EIGENVALUES,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2933)
C2933 FORMAT('      THE MATRIX MUST BE SYMMETRIC')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2935)
C2935 FORMAT('      ( A(I,J) = A(J,I) FOR ALL I AND J ).')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2936)
C2936 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2937)I2,J2,YM1IJ
C2937 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,2938)J2,I2,YM1JI
C2938 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
C
      IERR2=0
      IJOB=0
      CALL SGEEV(YM1,MAXROM,NR1,VECT9,YM2,MAXROM,Y3,
     1IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,2941)
        WRITE(ICOUT,2942)
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,2941)
        WRITE(ICOUT,2947)
        WRITE(ICOUT,2948)IERR2
        WRITE(ICOUT,2949)IERR2-1
      END IF
 2941 FORMAT('******** ERROR FROM MATARI ************')
 2942 FORMAT('         PROBLEM WITH MATRIX DIMENSIONS')
 2947 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 2948 FORMAT('         FOR EIGENVALUE ',I4)
 2949 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGE
C
      ITYP9='VECT'
      NVECT9=2*NR1
      GOTO9000
CCCCC END CHANGES
 2939 CONTINUE
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH EISPACK
CCCCC ALGORITHM.
CCCCC CALL JACOBI(YMJUNK,NR1,MAXROM,VECT9,YMJUN2,NJACIT)
C
      IERR2=0
      IJOB=0
      CALL SSIEV(YM1,MAXROM,NR1,VECT9,Y3,IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,2961)
        WRITE(ICOUT,2962)
      ELSE IF(IERR2.EQ.-2)THEN
        IERROR='YES'
        WRITE(ICOUT,2961)
        WRITE(ICOUT,2963)
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,2961)
        WRITE(ICOUT,2967)
        WRITE(ICOUT,2968)IERR2
        WRITE(ICOUT,2969)IERR2-1
      END IF
 2961 FORMAT('******** ERROR FROM MATARI ************')
 2962 FORMAT('         THE NUMBER OF ROWS GREATER THAN MAXIMUM')
 2963 FORMAT('         LESS THAN 1 ROW')
 2967 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 2968 FORMAT('         FOR EIGENVALUE ',I4)
 2969 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGE
C
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 30--                              **
C               **  TREAT THE MATRIX    EIGENVECTORS CASE  **
C               *********************************************
C
 3000 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO3009
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3001)
 3001 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3002)
 3002 FORMAT('      FOR MATRIX EIGENVECTORS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3003)
 3003 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3004)
 3004 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3005)
 3005 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3006)
 3006 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3007)NR1
 3007 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3008)NC1
 3008 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3009 CONTINUE
C
      DO3011I=1,NR1
      I2=I
      DO3012J=I,NC1
      J2=J
      YM1IJ=YM1(I,J)
      YM1JI=YM1(J,I)
      IF(YM1IJ.EQ.YM1JI)GOTO3012
      GOTO3030
 3012 CONTINUE
 3011 CONTINUE
      GOTO3039
 3030 CONTINUE
CCCCC JULY 1993.  ADD SUPPORT FOR NON-SYMMETRIC CASE.  THIS CASE
CCCCC CAN HAVE COMPLEX EIGENVECTORS.  ROWS 1 THROUGH N OF THE OUTPUT
CCCCC MATRIX WILL CONTAIN THE REAL COMPONENT, ROWS N+1 THROUGH 2*N 
CCCCC WILL CONTAIN THE COMPLEX COMPONENT.
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3031)
C3031 FORMAT('***** ERROR IN MATARI--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3032)
C3032 FORMAT('      FOR MATRIX EIGENVECTORS,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3033)
C3033 FORMAT('      THE MATRIX MUST BE SYMMETRIC')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3035)
C3035 FORMAT('      ( A(I,J) = A(J,I) FOR ALL I AND J ).')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3036)
C3036 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3037)I2,J2,YM1IJ
C3037 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3038)J2,I2,YM1JI
C3038 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
C
      IERR2=0
      IJOB=1
      DO3021J=1,MAXCOM
        DO3022I=1,MAXROM
          IF(J.GT.NR1 .OR. I.GT.NR1)YM1(I,J)=0.0
          YM2(I,J)=0.0
          YM9(I,J)=0.0
 3022   CONTINUE
 3021 CONTINUE
      DO3023I=1,MAXOBV
        VECT9(I)=0.0
        Y3(I)=0.0
 3023 CONTINUE
C
      CALL SGEEV(YM1,MAXROM,NR1,VECT9,YM2,MAXROM,Y3,
     1IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,3041)
        WRITE(ICOUT,3042)
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3041)
        WRITE(ICOUT,3047)
        WRITE(ICOUT,3048)IERR2
        WRITE(ICOUT,3049)IERR2-1
      ELSE
        DO3045J=1,NR1
        DO3044I=1,2*NR1
        YM9(I,J)=YM2(I,J)
 3044   CONTINUE
 3045   CONTINUE
      END IF
 3041 FORMAT('******** ERROR FROM MATARI ************')
 3042 FORMAT('         PROBLEM WITH MATRIX DIMENSIONS')
 3047 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 3048 FORMAT('         FOR EIGENVALUE ',I4)
 3049 FORMAT('         EIGENVECTORS 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGE
C
      ITYP9='MATR'
      NR9=2*NR1
      NC9=NC1
      IUPFLG='FULL'
CCCCC END CHANGES
      GOTO9000
 3039 CONTINUE
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH EISPACK
CCCCC ALGORITHM.
CCCCC CALL JACOBI(YMJUNK,NR1,MAXROM,VJUNK,YM9,NJACIT)
C
      IERR2=0
      IJOB=1
      DO3071I=1,MAXOBV
        VECT9(I)=0.0
        Y3(I)=0.0
 3071 CONTINUE
      CALL SSIEV(YM1,MAXROM,NR1,VECT9,Y3,IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,3061)
        WRITE(ICOUT,3062)
      ELSE IF(IERR2.EQ.-2)THEN
        IERROR='YES'
        WRITE(ICOUT,3061)
        WRITE(ICOUT,3063)
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3061)
        WRITE(ICOUT,3067)
        WRITE(ICOUT,3068)IERR2
        WRITE(ICOUT,3069)IERR2-1
      ELSE
        DO3080J=1,NR1
        DO3082I=1,NR1
        YM9(I,J)=YM1(I,J)
 3082   CONTINUE
 3080   CONTINUE
      END IF
 3061 FORMAT('******** ERROR FROM MATARI ************')
 3062 FORMAT('         THE NUMBER OF ROWS GREATER THAN MAXIMUM')
 3063 FORMAT('         LESS THAN 1 ROW')
 3067 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 3068 FORMAT('         FOR EIGENVALUE ',I4)
 3069 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 31--                                 **
C               **  TREAT THE MATRIX     RANK        CASE     **
C               **  COMPUTE FROM SINGULAR VALUE DECOMPOSITION **
C               ************************************************
C
CCCCC IMPLEMENTED JULY 1993.
 3100 CONTINUE
C
      IERR2=0
      AJOB=0.
      BJOB=0.
      AJOB=AJOB*BJOB
      CALL SSVDC(YM1,MAXROM,NR1,NC1,VECT9,Y3,YM1,MAXROM,
     1YM1,MAXROM,Y4,AJOB,IERR2)
      ARANK=0.
      IF(ITYPA2.EQ.'PARA')THEN
        ATOL=YS2
      ELSE
CCCCC   ATOL=0.0000001
        CALL SPDIV(RMXINT,2.0,IND,RESULT)
        ETA=RESULT+1.0
        CALL SPDIV(1.0,ETA,IND,ETA)
        ATOL=REAL(MAX(NR1,NC1))*VECT9(1)*ETA
      ENDIF
      NLAST=MIN(NR1,NC1)
      DO3120I=1,NLAST
      IF(VECT9(I).LE.ATOL)THEN
        ARANK=REAL(I-1)
        GOTO3129
      ENDIF
 3120 CONTINUE
      ARANK=REAL(NLAST)
 3129 CONTINUE 
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'TARI')GOTO3190
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3151)
 3151 FORMAT('***** COMPUTING RANK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3152)EPS,VECT9(1),ATOL
 3152 FORMAT('EPS,VECT((1),ATOL = ',
     1E15.7,2X,E15.7,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      NLAST=MIN(NR1+1,NC1)
      DO3180I=1,NLAST
      WRITE(ICOUT,3183)I,VECT9(I)
 3183 FORMAT('I,VECT9(I) = ',I4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 3180 CONTINUE
C
 3190 CONTINUE
C
CCCCC END CHANGE
C
      ITYP9='SCAL'
      SCAL9=ARANK
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 32--                              **
C               **  TREAT THE MATRIX     DETERMINANT CASE  **
C               **  REFERENCE--PRESS ET AL, PAGE 39        **
C               *********************************************
C
 3200 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO3209
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3201)
 3201 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3202)
 3202 FORMAT('      FOR MATRIX DETERMINANT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3203)
 3203 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3204)
 3204 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3205)
 3205 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3206)
 3206 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3207)NR1
 3207 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3208)NC1
 3208 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3209 CONTINUE
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH LINPACK
CCCCC ALGORITHM.
CCCCC CALL LUDCMP(YMJUNK,NR1,MAXROM,INDEX,DP1M1)
C
CCCCC DET=DP1M1
CCCCC DO3221I=1,NR1
CCCCC DET=DET*YMJUNK(I,I)
C3221 CONTINUE
      CALL SGECO(YM1,MAXROM,NR1,INDEX,RCOND,Y3)
      WRITE(ICOUT,3261)RCOND
      CALL DPWRST('XXX','TEXT ')
 3261 FORMAT('THE RECIPROCAL CONDITION NUMBER FOR THE MATRIX = ',E15.7)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,3271)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,3272)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      ELSE
        IJOB=10
        CALL SGEDI(YM1,MAXROM,NR1,INDEX,Y3,Y4,IJOB)
        DET=Y3(1)*10.0**Y3(2)
      END IF
 3271 FORMAT('****** ERROR IN MATARI ********')
 3272 FORMAT('       THE INPUT MATRIX IS SINGULAR')
CCCCC END CHANGE
C
      ITYP9='SCAL'
      SCAL9=DET
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 33--                              **
C               **  TREAT THE MATRIX     PERMANENT   CASE  **
C               *********************************************
C
 3300 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3311)
 3311 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3312)
 3312 FORMAT('      THE MATRIX PERMANENT COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3313)
 3313 FORMAT('      IS NOT YET IMPLEMENTED.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *******************************************************
C               **  STEP 34--                                        **
C               **  TREAT THE MATRIX     SPECTRAL NORM    CASE       **
C               **  SPECTRAL NORM = COMPUTE MATRIX TIMES ITS         **
C               **                  TRANSPOSE, THEN FIND THE SQUARE  **
C               **                  ROOT OF THE EIGENVALUE WITH THE  **
C               **                  LARGEST ABSOLUTE VALUE.          **
C               **  REFERENCE--RALSTON                               **
C               *******************************************************
C
 3400 CONTINUE
C
      IF(NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3411)
 3411   FORMAT('***** ERROR IN MATARI--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3413)NR1
 3413   FORMAT('      THE NUMBER OF ROWS IN THE MATRIX,',I5,
     1         'EXCEEDS THE MAXIMUM')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3415)MAXCOM
 3415   FORMAT('      NUMBER OF COLUMNS FOR A MATRIX,',I5,'.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,3417)
 3417   FORMAT('      THE MATRIX TRANSPOSE WAS NOT COMPUTED.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO3421I=1,NR1
      DO3422J=1,NR1
      DSUM=0.0D0
      DO3423K=1,NC1
      DYM1=YM1(I,K)
      DYM2=YM1(J,K)
      DYM9=DYM1*DYM2
      DSUM=DSUM+DYM9
 3423 CONTINUE
      YM2(I,J)=DSUM
 3422 CONTINUE
 3421 CONTINUE
      NRJ=NR1
      NCJ=NR1
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH THE EISPACK
CCCCC ALGORITHM.  NOTE THAT MATRIX TIMES IT TRANSPOSE IS SYMMETRIC, SO
CCCCC USE SYMMERIC VERSION.
CCCCC CALL JACOBI(YMJUNK,NRJ,MAXROM,VJUNK,YMJUN2,NJACIT)
C
      IERR2=0
      IJOB=0
      CALL SSIEV(YM2,MAXROM,NR1,Y3,Y4,IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,3451)
        WRITE(ICOUT,3452)
        GOTO9000
      ELSE IF(IERR2.EQ.-2)THEN
        IERROR='YES'
        WRITE(ICOUT,3451)
        WRITE(ICOUT,3453)
        GOTO9000
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3451)
        WRITE(ICOUT,3457)
        WRITE(ICOUT,3458)IERR2
        WRITE(ICOUT,3459)IERR2-1
        GOTO9000
      END IF
 3451 FORMAT('******** ERROR FROM MATARI ************')
 3452 FORMAT('         THE NUMBER OF ROWS GREATER THAN MAXIMUM')
 3453 FORMAT('         LESS THAN 1 ROW')
 3457 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 3458 FORMAT('         FOR EIGENVALUE ',I4)
 3459 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGES
      AMAX=ABS(Y3(1))
      DO3461I=1,NR1
      IF(ABS(Y3(I)).GT.AMAX)AMAX=ABS(Y3(I))
 3461 CONTINUE
      AMAX2=0.0
      IF(AMAX.GT.0.0)AMAX2=SQRT(AMAX)
C
      ITYP9='SCAL'
      SCAL9=AMAX2
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 35--                                        **
C               **  TREAT THE MATRIX     SPECTRAL RADIUS    CASE     **
C               **  SPECTRAL RADIUS = LARGEST ABS(EIGENVALUE) OF A   **
C               **  REFERENCE--RALSTON                               **
C               *******************************************************
C
 3500 CONTINUE
C
CCCCC JUNE 1995.  EISPACK WILL HANDLE NON-SYMMETRIC MATRICES (FOR
CCCCC EIGENVALUES).  NO NEED TO RESTRICT TO SYMMETRIC MATRICES).
CCCCC IF(NR1.EQ.NC1)GOTO3509
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3501)
C3501 FORMAT('***** ERROR IN MATARI--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3502)
C3502 FORMAT('      FOR MATRIX SPECTRAL RADIUS,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3503)
C3503 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3504)
C3504 FORMAT('      MUST EQUAL')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3505)
C3505 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3506)
C3506 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3507)NR1
C3507 FORMAT('            NUMBER OF ROWS    =',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3508)NC1
C3508 FORMAT('            NUMBER OF COLUMNS =',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
 3509 CONTINUE
C
      DO3511I=1,NR1
      I2=I
      DO3512J=I,NC1
      J2=J
      YM1IJ=YM1(I,J)
      YM1JI=YM1(J,I)
      IF(YM1IJ.EQ.YM1JI)GOTO3512
      GOTO3530
 3512 CONTINUE
 3511 CONTINUE
      GOTO3539
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH EISPACK
CCCCC EISPACK CAN HANDLE NON-SYMMETRIC MATRICES.
 3530 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3531)
C3531 FORMAT('***** ERROR IN MATARI--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3532)
C3532 FORMAT('      FOR MATRIX SPECTRAL RADIUS,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3533)
C3533 FORMAT('      THE MATRIX MUST BE SYMMETRIC')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3535)
C3535 FORMAT('      ( A(I,J) = A(J,I) FOR ALL I AND J ).')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3536)
C3536 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3537)I2,J2,YM1IJ
C3537 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,3538)J2,I2,YM1JI
C3538 FORMAT('            ELEMENT',I8,',',I8,' = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C
      IERR2=0
      IJOB=0
      CALL SGEEV(YM1,MAXROM,NR1,Y3,YM2,MAXROM,Y4,
     1IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,3541)
        WRITE(ICOUT,3542)
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3541)
        WRITE(ICOUT,3547)
        WRITE(ICOUT,3548)IERR2
        WRITE(ICOUT,3549)IERR2-1
      END IF
 3541 FORMAT('******** ERROR FROM MATARI ************')
 3542 FORMAT('         PROBLEM WITH MATRIX DIMENSIONS')
 3547 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 3548 FORMAT('         FOR EIGENVALUE ',I4)
 3549 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
C
C  COMPLEX ABSOLUTE VALUE IS DEFINED TO BE: SQRT(REAL**2+COMPLEX**2)
C
      AMAX=0.0
      ATEMP1=Y3(1)**2 + Y3(1+NR1)**2
      IF(ATEMP1.GE.0.0)AMAX=SQRT(ATEMP1)
      DO3538I=1,NR1
      ATEMP1=0.0
      ATEMP2=Y3(I)**2 + Y3(I+NR1)**2
      IF(ATEMP2.GE.0.0)ATEMP1=SQRT(ATEMP2)
      IF(ATEMP1.GT.AMAX)AMAX=ATEMP1
 3538 CONTINUE
      GOTO3599
C
CCCCC END CHANGE
 3539 CONTINUE
C
CCCCC JULY 1993.  REPLACE NUMERICAL RECIPES ALGORITHM WITH EISPACK
CCCCC CALL JACOBI(YMJUNK,NR1,MAXROM,VJUNK,YMJUN2,NJACIT)
C
      IERR2=0
      IJOB=0
      CALL SSIEV(YM1,MAXROM,NR1,Y3,Y4,IJOB,IERR2)
      IF(IERR2.EQ.-1)THEN
        IERROR='YES'
        WRITE(ICOUT,3561)
        WRITE(ICOUT,3562)
        GOTO9000
      ELSE IF(IERR2.EQ.-2)THEN
        IERROR='YES'
        WRITE(ICOUT,3561)
        WRITE(ICOUT,3563)
        GOTO9000
      ELSE IF(IERR2.GT.0)THEN
        IERROR='YES'
        WRITE(ICOUT,3561)
        WRITE(ICOUT,3567)
        WRITE(ICOUT,3568)IERR2
        WRITE(ICOUT,3569)IERR2-1
        GOTO9000
      END IF
 3561 FORMAT('******** ERROR FROM MATARI ************')
 3562 FORMAT('         THE NUMBER OF ROWS GREATER THAN MAXIMUM')
 3563 FORMAT('         LESS THAN 1 ROW')
 3567 FORMAT('         THE EIGENVALUE ALGORITHM FAILED TO CONVERGE ')
 3568 FORMAT('         FOR EIGENVALUE ',I4)
 3569 FORMAT('         EIGENVALUES 1 THRU ',I4,' ARE CORRECT')
CCCCC END CHANGES
C
      AMAX=ABS(Y3(1))
      DO3591I=1,NR1
      IF(ABS(Y3(I)).GT.AMAX)AMAX=ABS(Y3(I))
 3591 CONTINUE
C
 3599 CONTINUE
      ITYP9='SCAL'
      SCAL9=AMAX
      IUPFLG='FULL'
      GOTO9000
C
C               ***************************************************
C               **  STEP 36--                                    **
C               **  TREAT THE MATRIX     NUMBER OF ROWS    CASE  **
C               ***************************************************
C
 3600 CONTINUE
C
      SCAL9=NR1
C
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               ***************************************************
C               **  STEP 37--                                    **
C               **  TREAT THE MATRIX     NUMBER OF COLUMNS CASE  **
C               ***************************************************
C
 3700 CONTINUE
C
      SCAL9=NC1
C
      ITYP9='SCAL'
C
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 38--                                      **
C               **  TREAT THE MATRIX     SIMPLEX SOLUTION    CASE  **
C               **  REFERENCE--PRESS ET AL, PAGE 322               **
C               *****************************************************
C
 3800 CONTINUE
C
      NC2M2=NC2-2
C
      IF(N1.EQ.NC2M2)GOTO3809
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3801)
 3801 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3802)
 3802 FORMAT('      FOR MATRIX SIMPLEX SOLUTION OF OBJ. FUNCT. F.X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3803)
 3803 FORMAT('      SUBJECT TO THE CONSTRAINTS IN MATRIX C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3804)
 3804 FORMAT('      VIA   LET V = MATRIX SIMPLEX SOLUTION F C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3805)
 3805 FORMAT('      NUMBER OF ROWS IN OBJ. FUNCTION VECTOR F MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3806)
 3806 FORMAT('      BE EXACTLY 2 LESS THAN NUMBER OF COLUMNS IN C;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3807)N1
 3807 FORMAT('            VECTOR--',I8,' ROWS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3808)NR2,NC2
 3808 FORMAT('            MATRIX--',I8,' ROWS BY ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3809 CONTINUE
C
      IF(1.LE.N1.AND.N1.LE.MAXCOM)GOTO3819
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3811)
 3811 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3812)
 3812 FORMAT('      FOR MATRIX SIMPLEX SOLUTION OF OBJ. FUNCT. F.X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3813)
 3813 FORMAT('      SUBJECT TO THE CONSTRAINTS IN MATRIX C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3814)
 3814 FORMAT('      VIA   LET V = MATRIX SIMPLEX SOLUTION F C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3815)
 3815 FORMAT('      THE NUMBER OF ROWS IN OBJ. FUNCTION VECTOR F')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3816)MAXCOM
 3816 FORMAT('      MUST BE AT LEAST 1, AND AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3817)N1
 3817 FORMAT('            NUMBER OF ROWS = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3819 CONTINUE
C
      IF(1.LE.NR2.AND.NR2.LE.MAXROM)GOTO3829
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3821)
 3821 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3822)
 3822 FORMAT('      FOR MATRIX SIMPLEX SOLUTION OF OBJ. FUNCT. F.X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3823)
 3823 FORMAT('      SUBJECT TO THE CONSTRAINTS IN MATRIX C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3824)
 3824 FORMAT('      VIA   LET V = MATRIX SIMPLEX SOLUTION F C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3825)
 3825 FORMAT('      THE NUMBER OF CONSTRAINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3826)
 3826 FORMAT('      (THAT IS, THE NUMBER OF ROWS IN THE MATRIX C)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3827)MAXROM
 3827 FORMAT('      MUST BE AT LEAST 1, AND AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3828)NR2
 3828 FORMAT('            NUMBER OF CONSTRAINTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3829 CONTINUE
C
      IF(3.LE.NC2.AND.NC2.LE.MAXCOM)GOTO3839
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3831)
 3831 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3832)
 3832 FORMAT('      FOR MATRIX SIMPLEX SOLUTION OF OBJ. FUNCT. F.X')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3833)
 3833 FORMAT('      SUBJECT TO THE CONSTRAINTS IN MATRIX C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3834)
 3834 FORMAT('      VIA   LET V = MATRIX SIMPLEX SOLUTION F C')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3835)
 3835 FORMAT('      THE NUMBER OF COLUMNS IN THE CONSTRAINTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3836)MAXCOM
 3836 FORMAT('      MATRIX C MUST BE AT LEAST 3, AND AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3837)NC2
 3837 FORMAT('            NUMBER OF COLUMNS = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 3839 CONTINUE
C
      EPS=0.000001
      NR2P1=NR2+1
      NC2P=NC2-2
      NC2PP1=NC2P+1
      NC2M1=NC2-1
C
      DO3850J=1,NC2PP1
      YM9(1,J)=0.0
 3850 CONTINUE
C
      N1P1=N1+1
      DO3860J=2,N1P1
      JM1=J-1
      YM9(1,J)=Y1(JM1)
 3860 CONTINUE
C
      K=1
      DO3871ILOOP=1,3
C
      DO3872I=2,NR2P1
      IM1=I-1
      YTARG=YM2(IM1,NC2M1)
      IF(ILOOP.EQ.1.AND.YTARG.LT.-EPS)GOTO3873
      IF(ILOOP.EQ.1)GOTO3872
      IF(ILOOP.EQ.2.AND.EPS.LT.YTARG)GOTO3873
      IF(ILOOP.EQ.2)GOTO3872
      IF(ILOOP.EQ.3.AND.-EPS.LE.YTARG.AND.
     1                  YTARG.LE.EPS)GOTO3873
      IF(ILOOP.EQ.3)GOTO3872
 3873 CONTINUE
      K=K+1
C
      YM9(K,1)=YM2(IM1,NC2)
      DO3874J=2,NC2PP1
      JM1=J-1
      YM9(K,J)=(-YM2(IM1,JM1))
 3874 CONTINUE
C
 3872 CONTINUE
C
 3871 CONTINUE
C
      NLTZ=0
      NGTZ=0
      NEQZ=0
      DO3877I=1,NR2
      YTARG=YM2(I,NC2M1)
      IF(YTARG.LT.-EPS)NLTZ=NLTZ+1
      IF(EPS.LT.YTARG)NGTZ=NGTZ+1
      IF(-EPS.LE.YTARG.AND.YTARG.LE.EPS)NEQZ=NEQZ+1
 3877 CONTINUE
C
      CALL SIMPLX(YM9,NR2,NC2P,MAXROM,MAXCOM,NLTZ,NGTZ,NEQZ,
     1ICASE,IZROV,IPOSV,IBUGA3,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      DO3881I=1,N1
      VECT9(I)=0.0
 3881 CONTINUE
C
      DO3882I=1,NR2
      INDEX2=IPOSV(I)
      IP1=I+1
      IF(INDEX2.LE.N1)VECT9(INDEX2)=YM9(IP1,1)
 3882 CONTINUE
C
      ITYP9='VECT'
      NVECT9=N1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 41--                                      **
C               **  TREAT THE MATRIX     TRACE               CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
 4100 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO4109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4101)
 4101 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4102)
 4102 FORMAT('      FOR MATRIX TRACE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4103)
 4103 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4104)
 4104 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4105)
 4105 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
 4106 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4107)NR1
 4107 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4108)NC1
 4108 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4109 CONTINUE
C
      DSUM1=0.0D0
      DO4111I=1,NR1
      DYM1=YM1(I,I)
      DSUM1=DSUM1+DYM1
 4111 CONTINUE
C
      ITYP9='SCAL'
      SCAL9=DSUM1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 42--                                      **
C               **  TREAT THE MATRIX     SUBMATRIX           CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
 4200 CONTINUE
C
CCCCC  NO REASON FOR RESTRICTION ON SQUARE MATRICES FOR THIS 
CCCCC  COMMAND.  COMMENT OUT FOLLOWING SECTION.   DECEMBER 1994.
CCCCC  IF(NR1.EQ.NC1)GOTO4209
CCCCC  WRITE(ICOUT,999)
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4201)
C4201 FORMAT('***** ERROR IN MATARI--')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4202)
C4202 FORMAT('      FOR MATRIX SUBMATRIX,')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4203)
C4203 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4204)
C4204 FORMAT('      MUST EQUAL')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4205)
C4205 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4206)
C4206 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4207)NR1
C4207 FORMAT('            NUMBER OF ROWS    =',I8)
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  WRITE(ICOUT,4208)NC1
C4208 FORMAT('            NUMBER OF COLUMNS =',I8)
CCCCC  CALL DPWRST('XXX','BUG ')
CCCCC  IERROR='YES'
CCCCC  GOTO9000
C4209 CONTINUE
C
      IYS2=YS2+0.1
      IYS3=YS3+0.1
      I2=0
      J2=0
      DO4211I=1,NR1
      IF(I.EQ.IYS2)GOTO4211
      I2=I2+1
      NRJ=I2
      J2=0
      DO4212J=1,NC1
      IF(J.EQ.IYS3)GOTO4212
      J2=J2+1
      NCJ=J2
      YM2(I2,J2)=YM1(I,J)
 4212 CONTINUE
 4211 CONTINUE
C
      IF(NRJ.GE.1.AND.NCJ.GE.1)GOTO4229
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4221)
 4221 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4222)
 4222 FORMAT('      FOR MATRIX SUBMATRIX,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4223)
 4223 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4224)
 4224 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4225)
 4225 FORMAT('      MUST BOTH BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4226)
 4226 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4227)NRJ
 4227 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4228)NCJ
 4228 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4229 CONTINUE
C
      DO4231I=1,NRJ
      DO4232J=1,NCJ
      YM9(I,J)=YM2(I,J)
 4232 CONTINUE
 4231 CONTINUE
C
      ITYP9='MATR'
CCCCC DECEMBER 1994.  FOLLOWING IS BACKWARDS.
CCCCC NR9=NCJ
CCCCC NC9=NRJ
      NR9=NRJ
      NC9=NCJ
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 43--                                      **
C               **  TREAT THE MATRIX     MINOR               CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
 4300 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO4309
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4301)
 4301 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4302)
 4302 FORMAT('      FOR MATRIX MINOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4303)
 4303 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4304)
 4304 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4305)
 4305 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4306)
 4306 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4307)NR1
 4307 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4308)NC1
 4308 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4309 CONTINUE
C
      IYS2=YS2+0.1
      IYS3=YS3+0.1
      I2=0
      J2=0
      DO4311I=1,NR1
      IF(I.EQ.IYS2)GOTO4311
      I2=I2+1
      NRJ=I2
      J2=0
      DO4312J=1,NC1
      IF(J.EQ.IYS3)GOTO4312
      J2=J2+1
      NCJ=J2
      YM2(I2,J2)=YM1(I,J)
 4312 CONTINUE
 4311 CONTINUE
C
      IF(NRJ.GE.1.AND.NCJ.GE.1)GOTO4329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4321)
 4321 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4322)
 4322 FORMAT('      FOR MATRIX MINOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4323)
 4323 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4324)
 4324 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4325)
 4325 FORMAT('      MUST BOTH BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4326)
 4326 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4327)NRJ
 4327 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4328)NCJ
 4328 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4329 CONTINUE
C
      IF(NRJ.EQ.NCJ)GOTO4339
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4331)
 4331 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4332)
 4332 FORMAT('      FOR MATRIX MINOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4333)
 4333 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4334)
 4334 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4335)
 4335 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4336)
 4336 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4337)NRJ
 4337 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4338)NCJ
 4338 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4339 CONTINUE
C
CCCCC JULY 1993.  USE LINPACK ROUTINE TO COMPUTE THE DETERMINANT.
CCCCC CALL LUDCMP(YMJUNK,NRJ,MAXROM,INDEX,DP1M1)
C
CCCCC DPROD=DP1M1
CCCCC DO4341I=1,NRJ
CCCCC DYM9=YMJUNK(I,I)
CCCCC DPROD=DPROD*DYM9
C4341 CONTINUE
CCCCC DET=DPROD
CCCCC AMINOR=DET
C
      CALL SGECO(YM2,MAXROM,NRJ,INDEX,RCOND,Y3)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,4371)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,4372)
        CALL DPWRST('XXX','ERRO ')
        COFACT=0.0
        IERROR='YES'
      ELSE
        IJOB=10
        CALL SGEDI(YM2,MAXROM,NRJ,INDEX,Y3,Y4,IJOB)
        DET=Y3(1)*10.0**Y3(2)
        AMINOR=DET
      END IF
 4371 FORMAT('****** ERROR IN MATARI ********')
 4372 FORMAT('       UNABLE TO COMPUTE THE DETERMINANT')
CCCCC END CHANGE
C
      ITYP9='SCAL'
      SCAL9=AMINOR
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 44--                                      **
C               **  TREAT THE MATRIX     COFACTOR            CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
 4400 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO4409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4401)
 4401 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4402)
 4402 FORMAT('      FOR MATRIX COFACTOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4403)
 4403 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4404)
 4404 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4405)
 4405 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4406)
 4406 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4407)NR1
 4407 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4408)NC1
 4408 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4409 CONTINUE
C
      IYS2=YS2+0.1
      IYS3=YS3+0.1
      I2=0
      J2=0
      DO4411I=1,NR1
      IF(I.EQ.IYS2)GOTO4411
      I2=I2+1
      NRJ=I2
      J2=0
      DO4412J=1,NC1
      IF(J.EQ.IYS3)GOTO4412
      J2=J2+1
      NCJ=J2
      YM2(I2,J2)=YM1(I,J)
 4412 CONTINUE
 4411 CONTINUE
C
      IF(NRJ.GE.1.AND.NCJ.GE.1)GOTO4429
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4421)
 4421 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4422)
 4422 FORMAT('      FOR MATRIX COFACTOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4423)
 4423 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX, AND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4424)
 4424 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4425)
 4425 FORMAT('      MUST BOTH BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4426)
 4426 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4427)NRJ
 4427 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4428)NCJ
 4428 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4429 CONTINUE
C
      IF(NRJ.EQ.NCJ)GOTO4439
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4431)
 4431 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4432)
 4432 FORMAT('      FOR MATRIX COFACTOR,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4433)
 4433 FORMAT('      THE NUMBER OF ROWS IN THE SUBMATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4434)
 4434 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4435)
 4435 FORMAT('      THE NUMBER OF COLUMNS IN THE SUBMATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4436)
 4436 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4437)NRJ
 4437 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4438)NCJ
 4438 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 4439 CONTINUE
C
CCCCC JULY 1993.  USE LINPACK ROUTINE TO COMPUTE THE DETERMINANT.
CCCCC CALL LUDCMP(YMJUNK,NRJ,MAXROM,INDEX,DP1M1)
C
CCCCC DPROD=DP1M1
CCCCC DO4441I=1,NRJ
CCCCC DYM9=YMJUNK(I,I)
CCCCC DPROD=DPROD*DYM9
C4441 CONTINUE
CCCCC DET=DPROD
C
      CALL SGECO(YM2,MAXROM,NRJ,INDEX,RCOND,Y3)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,4471)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,4472)
        CALL DPWRST('XXX','ERRO ')
        COFACT=0.0
        IERROR='YES'
      ELSE
        IJOB=10
        CALL SGEDI(YM2,MAXROM,NRJ,INDEX,Y3,Y4,IJOB)
        DET=Y3(1)*10.0**Y3(2)
        COFACT=DET
        IYS23=IYS2+IYS3
        IREM=IYS23-2*(IYS23/2)
        IF(IREM.EQ.1)COFACT=(-COFACT)
      END IF
 4471 FORMAT('****** ERROR IN MATARI ********')
 4472 FORMAT('       UNABLE TO COMPUTE THE DETERMINANT')
CCCCC END CHANGE
C
      ITYP9='SCAL'
      SCAL9=COFACT
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 45--                                      **
C               **  TREAT THE MATRIX     DEFINITION          CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
CCCCC OCTOBER 1993.  ADD OPTIONAL SYNTAX.  IF FOURTH PARAMETER 
CCCCC SPECIFIED, LET IT BE THE STARTING ROW NUMBER.
 4500 CONTINUE
C
      IF(ITYPA4.EQ.'PARA')GOTO4560
      DO4511I=1,NR1
      DO4512J=1,NC1
      YM9(I,J)=YM1(I,J)
 4512 CONTINUE
 4511 CONTINUE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      GOTO9000
CCCCC OCTOBER 1993.  ADD FOLLOWING SECTION
 4560 CONTINUE
      IROWID=YS4+0.5
      IF(IROWID.LT.1.OR.IROWID.GT.NR1)IROWID=1
      ICOUNT=0
CCCCC NLAST=IROWID+NR1-1
      NLAST=NR1
      IF(NLAST.GT.MAXROM)NLAST=MAXROM
      DO4561I=IROWID,NLAST
      ICOUNT=ICOUNT+1
      DO4562J=1,NC1
      YM9(ICOUNT,J)=YM1(I,J)
 4562 CONTINUE
 4561 CONTINUE
C
      ITYP9='MATR'
      NR9=ICOUNT
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 46--                                      **
C               **  TREAT THE MATRIX     EUCLIDEAN NORM      CASE  **
C               **  REFERENCE--RALSTON, PAGE XXX                   **
C               *****************************************************
C
 4600 CONTINUE
C
      DSUM1=0.0D0
      DO4621I=1,NR1
      DO4622J=1,NC1
      DYM1=YM1(I,J)
      DSUM1=DSUM1+DYM1*DYM1
 4622 CONTINUE
 4621 CONTINUE
      DSUM2=0.0D0
      IF(DSUM1.GT.0.0D0)DSUM2=SQRT(DSUM1)
C
      ITYP9='SCAL'
      SCAL9=DSUM2
      IUPFLG='FULL'
      GOTO9000
C
C               **************************************************************
C               **  STEP 51--                                               **
C               **  TREAT THE VARIANCE-COVARIANCE CASE                      **
C               **************************************************************
C
 5100 CONTINUE
C
CCCCC JULY 2002.  SUPPORT FOR WINSORIZED CORRELATION.
C
CCCCC NOVEMBER 2004.  SUPPORT FOR ROW BASED (AS OPPOSSED TO COLUMN
CCCCC                 BASED COVARIANCES.
C
      IF(ICOVDI.EQ.'COLU')THEN
        IWRITE='OFF'
        DO5151J=1,NC1
          DO5161K=1,NC1
            DO5155I=1,NR1
              Y3(I)=YM1(I,J)
              Y4(I)=YM1(I,K)
 5155       CONTINUE
            IF(ICOVTY.EQ.'RANK')THEN
              CALL RANKCV(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'WINS')THEN
              CALL WINSOR(Y3,NR1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5181I=1,NR1
                Y3(I)=Y2(I)
 5181         CONTINUE
              CALL WINSOR(Y4,NR1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5186I=1,NR1
                Y4(I)=Y2(I)
 5186         CONTINUE
              CALL COV(Y3,Y4,NR1,IWRITE,RIGHT,IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'BIWE')THEN
              CALL BIWMCV(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSE
              CALL COV(Y3,Y4,NR1,IWRITE,RIGHT,IBUGA3,IERROR)
            ENDIF
            YM9(J,K)=RIGHT
 5161     CONTINUE
 5151   CONTINUE
      ELSE
        IWRITE='OFF'
        DO5121J=1,NR1
          DO5131K=1,NR1
            DO5125I=1,NC1
              Y3(I)=YM1(J,I)
              Y4(I)=YM1(K,I)
 5125       CONTINUE
            IF(ICOVTY.EQ.'RANK')THEN
              CALL RANKCV(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'WINS')THEN
              CALL WINSOR(Y3,NC1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5141I=1,NC1
                Y3(I)=Y2(I)
 5141         CONTINUE
              CALL WINSOR(Y4,NC1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5146I=1,NC1
                Y4(I)=Y2(I)
 5146         CONTINUE
              CALL COV(Y3,Y4,NC1,IWRITE,RIGHT,IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'BIWE')THEN
              CALL BIWMCV(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSE
              CALL COV(Y3,Y4,NC1,IWRITE,RIGHT,IBUGA3,IERROR)
            ENDIF
            YM9(J,K)=RIGHT
 5131     CONTINUE
 5121   CONTINUE
      ENDIF
C
C
      ITYP9='MATR'
      NR9=NC1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               **************************************************************
C               **  STEP 52--                                               **
C               **  TREAT THE CORRELATION CASE                              **
C               **************************************************************
C
 5200 CONTINUE
C
CCCCC JULY 2002.  SUPPORT FOR WINSORIZED CORRELATION, RANK CORRELATION,
CCCCC             BIWEIGHT MID CORRELATION.
CCCCC NOVEMBER 2004.  SUPPORT FOR ROW BASED (AS OPPOSSED TO COLUMN
CCCCC                 BASED CORRELATIONS.  ALSO, ADD SUPPORT FOR
CCCCC                 KENDELL'S TAU CORRELATION.
C
      IF(ICORDI.EQ.'COLU')THEN
        IWRITE='OFF'
        DO5251J=1,NC1
          DO5261K=1,NC1
            DO5255I=1,NR1
              Y3(I)=YM1(I,J)
              Y4(I)=YM1(I,K)
 5255       CONTINUE
            IF(ICORTY.EQ.'RANK')THEN
              CALL RANKCR(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSEIF(ICORTY.EQ.'WINS')THEN
              CALL WINSOR(Y3,NR1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5281I=1,NR1
                Y3(I)=Y2(I)
 5281         CONTINUE
              CALL WINSOR(Y4,NR1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5286I=1,NR1
                Y4(I)=Y2(I)
 5286         CONTINUE
              CALL CORR(Y3,Y4,NR1,IWRITE,RIGHT,IBUGA3,IERROR)
            ELSEIF(ICORTY.EQ.'PBCR')THEN
              CALL PBNCOR(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGHT,BETA,
     1                    IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'BIWE')THEN
              CALL BIWMDV(Y3,NR1,IWRITE,Y1,Y2,MAXOBV,RIGH1,
     1                    IBUGA3,IERROR)
              CALL BIWMDV(Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGH2,
     1                    IBUGA3,IERROR)
              CALL BIWMCV(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGH3,
     1                    IBUGA3,IERROR)
              RIGH4=RIGH1*RIGH2
              IF(RIGH4.GT.0.0)THEN
                RIGHT=RIGH3/SQRT(RIGH4)
              ELSE
                RIGHT=0.0
              ENDIF
            ELSEIF(ICORTY.EQ.'KTAU')THEN
              CALL KENTAU(Y3,Y4,NR1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSE
              CALL CORR(Y3,Y4,NR1,IWRITE,RIGHT,IBUGA3,IERROR)
            ENDIF
            YM9(J,K)=RIGHT
 5261     CONTINUE
 5251   CONTINUE
      ELSE
        IWRITE='OFF'
        DO5221J=1,NR1
          DO5231K=1,NR1
            DO5225I=1,NC1
              Y3(I)=YM1(J,I)
              Y4(I)=YM1(K,I)
 5225       CONTINUE
            IF(ICORTY.EQ.'RANK')THEN
              CALL RANKCR(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSEIF(ICORTY.EQ.'WINS')THEN
              CALL WINSOR(Y3,NC1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5241I=1,NC1
                Y3(I)=Y2(I)
 5241         CONTINUE
              CALL WINSOR(Y4,NC1,P1,P2,IWRITE,Y1,MAXOBV,Y2,
     1                    IBUGA3,IERROR)
              DO5246I=1,NC1
                Y4(I)=Y2(I)
 5246         CONTINUE
              CALL CORR(Y3,Y4,NC1,IWRITE,RIGHT,IBUGA3,IERROR)
            ELSEIF(ICORTY.EQ.'PBCR')THEN
              CALL PBNCOR(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGHT,BETA,
     1                    IBUGA3,IERROR)
            ELSEIF(ICOVTY.EQ.'BIWE')THEN
              CALL BIWMDV(Y3,NC1,IWRITE,Y1,Y2,MAXOBV,RIGH1,
     1                    IBUGA3,IERROR)
              CALL BIWMDV(Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGH2,
     1                    IBUGA3,IERROR)
              CALL BIWMCV(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGH3,
     1                    IBUGA3,IERROR)
              RIGH4=RIGH1*RIGH2
              IF(RIGH4.GT.0.0)THEN
                RIGHT=RIGH3/SQRT(RIGH4)
              ELSE
                RIGHT=0.0
              ENDIF
            ELSEIF(ICORTY.EQ.'KTAU')THEN
              CALL KENTAU(Y3,Y4,NC1,IWRITE,Y1,Y2,MAXOBV,RIGHT,
     1                    IBUGA3,IERROR)
            ELSE
              CALL CORR(Y3,Y4,NC1,IWRITE,RIGHT,IBUGA3,IERROR)
            ENDIF
            YM9(J,K)=RIGHT
 5231     CONTINUE
 5221   CONTINUE
      ENDIF
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               **************************************************************
C               **  STEP 53--                                               **
C               **  TREAT THE PRINCIPLE COMPONENTS CASE                     **
C               **  TREAT THE PRINCIPLE COMPONENTS EIGENVECTORS CASE        **
C               **  TREAT THE PRINCIPLE COMPONENTS EIGENVALUES CASE         **
C               **  REFERENCE--JACKSON, J. E. (1980, 1981)                  **
C               **             PRINCIPLE COMPONENTS AND FACTOR ANALYSIS:    **
C               **             PART 1--PRINCIPLE COMPONENTS,                **
C               **             JQT OCT 1980, PAGES 201-213.                 **
C               **             PART 2--ADDITIONAL TOPICS RELATED            **
C               **             TO PRINCIPLE COMPONENTS,                     **
C               **             JQT JAN 1981, PAGES 46-58.                   **
C               **             PART 3--WHAT IS FACTOR ANALYSIS?,            **
C               **             JQT APR 1981, PAGES 125-130.                 **
C               **  REFERENCE--LAWTON, W. H., SYLVESTRE, E. A.,             **
C               **             AND MAGGIA, M. S. (1972).                    **
C               **             SELF MODELING NONLINEAR REGRESSION.          **
C               **             TECHNOMETRICS, AUGUST, 1972,                 **
C               **             PAGES 513-532.                               **
C               **************************************************************
C
 5300 CONTINUE
C
      IF(PCCASE.EQ.'DACV')GOTO5310
      IF(PCCASE.EQ.'DACR')GOTO5310
      GOTO5329
C
 5310 CONTINUE
      DO5311J=1,NC1
      DSUM1=0.0D0
      DO5312I=1,NR1
      DYM1=YM1(I,J)
      DSUM1=DSUM1+DYM1
 5312 CONTINUE
      DMEAN(J)=D999
      DDENOM=DNR1
      IF(DDENOM.NE.0.0D0)DMEAN(J)=DSUM1/DDENOM
 5311 CONTINUE
C
      DO5321J=1,NC1
      DO5322K=J,NC1
      DSUM1=0.0D0
      DO5323I=1,NR1
      DYM1=YM1(I,J)
      DYM2=YM1(I,K)
      DDEL1=DYM1-DMEAN(J)
      DDEL2=DYM2-DMEAN(K)
      DSUM1=DSUM1+DDEL1*DDEL2
 5323 CONTINUE
      DCOV=D999
      DDENOM=DNR1-1.0D0
      IF(DDENOM.NE.0.0D0)DCOV=DSUM1/DDENOM
      YM2(J,K)=DCOV
      YM2(K,J)=DCOV
 5322 CONTINUE
 5321 CONTINUE
 5329 CONTINUE
C
      IF(PCCASE.EQ.'DACV')GOTO5360
      IF(PCCASE.EQ.'DACR')GOTO5340
      IF(PCCASE.EQ.'CVCV')GOTO5330
      IF(PCCASE.EQ.'CVCR')GOTO5330
      IF(PCCASE.EQ.'CRCV')GOTO5350
      IF(PCCASE.EQ.'CRCR')GOTO5330
      GOTO5360
C
 5330 CONTINUE
      DO5331I=1,NR1
      DO5332J=1,NC1
      YM2(I,J)=YM1(I,J)
 5332 CONTINUE
 5331 CONTINUE
      IF(PCCASE.EQ.'CVCR')GOTO5340
      GOTO5360
C
 5340 CONTINUE
      DO5341I=1,NC1
      S1=YM2(I,I)
      S1=SQRT(S1)
      DO5342J=1,NC1
      S2=YM2(J,J)
      S2=SQRT(S2)
      IF(I.EQ.J)GOTO5342
      S1S2=S1*S2
      IF(S1S2.LE.0.0)YM2(I,J)=(-999.99)
      IF(S1S2.GT.0.0)YM2(I,J)=YM2(I,J)/S1S2
 5342 CONTINUE
 5341 CONTINUE
      DO5343I=1,NC1
      YM2(I,I)=1.0
 5343 CONTINUE
      GOTO5360
C
 5350 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5351)
 5351 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5352)
 5352 FORMAT('       ILLEGAL PRINCIPLE COMPONENTS TYPE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5353)
 5353 FORMAT('      YOU CANNOT SPECIFY THAT THE STARTING MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5354)
 5354 FORMAT('      IS THE CORRELATION MATRIX,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5355)
 5355 FORMAT('      AND THEN SPECIFY THAT THE INTERMEDIATE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5356)
 5356 FORMAT('      IS THE COVARIANCE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5357)
 5357 FORMAT('      (SINCE LATTER CANNOT BE DERIVED FROM FORMER).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5358)
 5358 FORMAT('      FIX BY USING THE    PRINCIPLE COMPONENTS TYPE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5359)
 5359 FORMAT('      COMMAND.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5360 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TARI')GOTO5361
      GOTO5369
 5361 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5362)
 5362 FORMAT('***** FROM THE MIDDLE OF MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5363)NC1,MAXCOM
 5363 FORMAT('NC1,MAXCOM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO5364I=1,NC1
      DO5365J=1,NC1
      WRITE(ICOUT,5366)I,J,YM2(I,J)
 5366 FORMAT('I,J,YM2(I,J) = ',2I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 5365 CONTINUE
 5364 CONTINUE
 5369 CONTINUE
C
CCCCC JULY 1993.  USE EISPACK ROUTINES (NOTE THAT CORRELATION OR 
CCCCC COVARIANCE MATRIX IS SYMMETRIC).
CCCCC ALSO, SINCE MAXROM AND MAXCOM NO LONGER EQUAL, BE SURE TO SEND
CCCCC MAXROM AS MATRIX LEADING DIMENSION.
CCCCC CALL JACOBI(YMJUNK,NC1,MAXCOM,VJUNK,YM9,NJACIT)
C
      IERR2=0
      IJOB=1
      DO5650J=1,NC1
      DO5651I=1,NC1
      YM9(I,J)=YM2(I,J)
 5651 CONTINUE
 5650 CONTINUE
      CALL SSIEV(YM9,MAXROM,NC1,Y3,Y4,IJOB,IERR2)
      IF(IERR2.NE.0)THEN
        IERROR='YES'
        WRITE(ICOUT,5661)
        WRITE(ICOUT,5662)
        WRITE(ICOUT,5663)
        GOTO9000
      END IF
 5661 FORMAT('******** ERROR FROM MATARI ************')
 5662 FORMAT('         UNABLE TO CALCULATE EIGENVALUES CORRECTLY.')
 5663 FORMAT('         PRINCIPLE COMPONENTS WERE NOT COMPUTED.')
CCCCC END CHANGE
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'TARI')GOTO5371
      GOTO5379
 5371 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5372)
 5372 FORMAT('***** FROM THE MIDDLE OF MATARI--')
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,5373)NC1,MAXCOM,NJACIT
C5373 FORMAT('NC1,MAXCOM,NJACIT = ',3I8)
      WRITE(ICOUT,5373)NC1,MAXCOM
 5373 FORMAT('NC1,MAXCOM= ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO5374I=1,NC1
      DO5375J=1,NC1
      WRITE(ICOUT,5376)I,J,YM9(I,J),Y3(I)
 5376 FORMAT('I,J,YM9(I,J),Y3(I) = ',2I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5375 CONTINUE
 5374 CONTINUE
 5379 CONTINUE
C
      DO5380I=1,NC1
CCCCC AINDE2(I)=I
      Y1(I)=I
 5380 CONTINUE
C
CCCCC CALL SORTC(Y3,AINDE2,NC1,Y4,AINDE3)
      CALL SORTC(Y3,Y1,NC1,Y4,Y2)
C
      DO5390J=1,NC1
      JREV=NC1-J+1
CCCCC INDEX3=AINDE3(JREV)+0.5
      INDEX3=Y2(JREV)+0.5
      VECT9(J)=Y3(INDEX3)
 5390 CONTINUE
C
      DO5411J=1,NC1
      JREV=NC1-J+1
CCCCC INDEX3=AINDE3(JREV)+0.5
      INDEX3=Y2(JREV)+0.5
      DO5412I=1,NC1
      YM2(I,J)=YM9(I,INDEX3)
 5412 CONTINUE
 5411 CONTINUE
C
      DO5416I=1,NC1
      DO5417J=1,NC1
      YM9(I,J)=YM2(I,J)
 5417 CONTINUE
 5416 CONTINUE
C
      IF(IMCASE.EQ.'MAPC')GOTO5430
      GOTO5500
C
 5430 CONTINUE
      IF(IMSUBC.EQ.'EVEC')GOTO5440
      IF(IMSUBC.EQ.'EVAL')GOTO5450
      GOTO5460
C
 5440 CONTINUE
      ITYP9='MATR'
      NR9=NC1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 5450 CONTINUE
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 5460 CONTINUE
      DO5461I=1,NR1
      DO5462J=1,NC1
      DSUM=0.0D0
      DO5463K=1,NC1
      DYM1=YM1(I,K)
      DDEL=DYM1-DMEAN(K)
      DYM2=YM9(K,J)
      DYM9=DDEL*DYM2
      DSUM=DSUM+DYM9
 5463 CONTINUE
      YM2(I,J)=DSUM
 5462 CONTINUE
 5461 CONTINUE
      DO5465I=1,NR1
      DO5466J=1,NC1
      YM9(I,J)=YM2(I,J)
 5466 CONTINUE
 5465 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 5500 CONTINUE
      L=1
      IF(IMCASE.EQ.'MAP2')L=2
      IF(IMCASE.EQ.'MAP3')L=3
      IF(IMCASE.EQ.'MAP4')L=4
      IF(IMCASE.EQ.'MAP5')L=5
      IF(IMCASE.EQ.'MAP6')L=6
      IF(IMCASE.EQ.'MAP7')L=7
      IF(IMCASE.EQ.'MAP8')L=8
      IF(IMCASE.EQ.'MAP9')L=9
      IF(IMCASE.EQ.'MA10')L=10
C
      IF(IMSUBC.EQ.'EVEC')GOTO5530
      IF(IMSUBC.EQ.'EVAL')GOTO5540
      GOTO5550
C
 5530 CONTINUE
      DO5531I=1,NC1
      VECT9(I)=YM9(I,L)
 5531 CONTINUE
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 5540 CONTINUE
      ITYP9='SCAL'
      SCAL9=VECT9(L)
      IUPFLG='FULL'
      GOTO9000
C
 5550 CONTINUE
      DO5551I=1,NR1
      DSUM=0.0D0
      DO5553K=1,NC1
      DYM1=YM1(I,K)
      DDEL=DYM1-DMEAN(K)
      DYM2=YM9(K,L)
      DYM9=DDEL*DYM2
      DSUM=DSUM+DYM9
 5553 CONTINUE
      VECT9(I)=DSUM
 5551 CONTINUE
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               **************************************************
C               **  STEP 54--                                   **
C               **  TREAT THE MATRIX TRUNCATION      CASE       **
C               **  THIS COMMAND SETS ANY VALUE BELOW THE       **
C               **  TRUNCATION VALUE TO THAT TRUNCATION         **
C               **  VALUE.  A COMMON USE OF THIS COMMAND        **
C               **  MIGHT BE TO REMOVE BACKGROUND (USE          **
C               **  MATRIX SUBTRACTION TO REMOVE THE            **
C               **  BACKGROUND AND THEN USE MATRIX TRUNCATION   **
C               **  TO SET ANY RESULTING NEGATIVE VALUES (I.E., **
C               **  POINTS BELOW THE BACKGROUND LEVEL) TO ZERO. **
C               **************************************************
C
 6100 CONTINUE
C
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'PARA')GOTO6170
      IF(ITYPA1.EQ.'PARA'.AND.ITYPA2.EQ.'MATR')GOTO6180
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6101)
 6101 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6102)
 6102 FORMAT('      ILLEGAL ARGUMENT TYPES FOR MATRIX TRUNCATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6103)ITYPA1
 6103 FORMAT('            TYPE FOR ARGUMENT 1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6104)ITYPA2
 6104 FORMAT('            TYPE FOR ARGUMENT 2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6170 CONTINUE
      DO6171I=1,NR1
      DO6172J=1,NC1
        YM9(I,J)=MAX(YM1(I,J),YS2)
 6172 CONTINUE
 6171 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 6180 CONTINUE
      DO6181I=1,NR1
      DO6182J=1,NC1
        YM9(I,J)=MAX(YM2(I,J),YS1)
 6182 CONTINUE
 6181 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
C               **************************************************
C               **  STEP 55--                                   **
C               **  TREAT THE MATRIX UPPER TRUNCATION   CASE    **
C               **  THIS COMMAND SETS ANY VALUE ABOVE THE       **
C               **  TRUNCATION VALUE TO THAT TRUNCATION         **
C               **  VALUE.                                      **
C               **************************************************
C
 6200 CONTINUE
C
      IF(ITYPA1.EQ.'MATR'.AND.ITYPA2.EQ.'PARA')GOTO6270
      IF(ITYPA1.EQ.'PARA'.AND.ITYPA2.EQ.'MATR')GOTO6280
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6201)
 6201 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6202)
 6202 FORMAT('      ILLEGAL ARGUMENT TYPES FOR MATRIX UPPER ',
     1       'TRUNCATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6203)ITYPA1
 6203 FORMAT('            TYPE FOR ARGUMENT 1 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6204)ITYPA2
 6204 FORMAT('            TYPE FOR ARGUMENT 2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6270 CONTINUE
      DO6271I=1,NR1
      DO6272J=1,NC1
        YM9(I,J)=MIN(YM1(I,J),YS2)
 6272 CONTINUE
 6271 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
 6280 CONTINUE
      DO6281I=1,NR1
      DO6282J=1,NC1
        YM9(I,J)=MIN(YM2(I,J),YS1)
 6282 CONTINUE
 6281 CONTINUE
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'TARI')GOTO9090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4
 9012 FORMAT('IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMCASE,IMSUBC
 9013 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMVAR,IWRITE
 9014 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)YS1,YS2,YS3,YS4
 9015 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IERROR
 9016 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IYS2,IYS3,IYS23,NRJ,NCJ
 9017 FORMAT('IYS2,IYS3,IYS23,NRJ,NCJ = ',5I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NR1,NC1
 9031 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO9039
      IF(NC1.LE.0)GOTO9039
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO9032I=1,NR1
      WRITE(ICOUT,9033)I,(YM1(I,J),J=1,JMAX)
 9033 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9039 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NR2,NC2
 9041 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9049
      IF(NC2.LE.0)GOTO9049
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO9042I=1,NR2
      WRITE(ICOUT,9043)I,(YM2(I,J),J=1,JMAX)
 9043 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9049 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NR9,NC9
 9051 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9059
      IF(NC9.LE.0)GOTO9059
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9055I=1,NR9
      WRITE(ICOUT,9056)I,(YM9(I,J),J=1,JMAX)
 9056 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9055 CONTINUE
 9059 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9111)N1
 9111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO9119
      DO9112I=1,N1
      WRITE(ICOUT,9113)I,Y1(I)
 9113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9112 CONTINUE
 9119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9121)N2
 9121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO9129
      DO9122I=1,N2
      WRITE(ICOUT,9123)I,Y2(I)
 9123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9122 CONTINUE
 9129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9131)N3
 9131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO9139
      DO9132I=1,N3
      WRITE(ICOUT,9133)I,Y3(I)
 9133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9132 CONTINUE
 9139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9141)N4
 9141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO9149
      DO9142I=1,N4
      WRITE(ICOUT,9143)I,Y4(I)
 9143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9142 CONTINUE
 9149 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9151)ITYP9,SCAL9
 9151 FORMAT('ITYP9,SCAL9 = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9161)NVECT9
 9161 FORMAT('NVECT9 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NVECT9.LE.0)GOTO9169
      DO9162I=1,NVECT9
      WRITE(ICOUT,9163)I,VECT9(I)
 9163 FORMAT('I,VECT9(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9162 CONTINUE
 9169 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9171)NR9,NC9
 9171 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9179
      IF(NC9.LE.0)GOTO9179
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9172I=1,NR9
      WRITE(ICOUT,9173)I,(YM9(I,J),J=1,JMAX)
 9173 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9172 CONTINUE
 9179 CONTINUE
C
      IF(IMCASE.NE.'MASS')GOTO9189
      WRITE(ICOUT,9181)NR2,NC2
 9181 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9189
      IF(NC2.LE.0)GOTO9189
      JMAX=NC2+1
      IF(JMAX.GT.10)JMAX=10
      NR2P1=NR2+1
      DO9182I=1,NR2P1
      WRITE(ICOUT,9183)I,(YM2(I,J),J=1,JMAX)
 9183 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9182 CONTINUE
      DO9185I=1,N3
      WRITE(ICOUT,9186)ICASE,I,IZROV(I),IPOSV(I)
 9186 FORMAT('ICASE,I,IZROV(I),IPOSV(I) = ',4I8)
      CALL DPWRST('XXX','BUG ')
 9185 CONTINUE
      WRITE(ICOUT,9187)NR2,NLTZ,NGTZ,NEQZ
 9187 FORMAT('NR2,NLTZ,NGTZ,NEQZ = ',4I8)
      CALL DPWRST('XXX','BUG ')
 9189 CONTINUE
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MATAR2(YM1,NR1,NC1,YM2,NR2,NC2,NR3,NC3,MAXROM,MAXCOM,
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC SUBROUTINE MATAR2(YM1,NR1,NC1,YM2,NR2,NC2,YM3,NR3,NC3,
     1Y1,N1,Y2,N2,Y3,N3,Y4,N4,
     1INDEX,
     1YS1,YS2,YS3,YS4,
     1IMCASE,IUPFLG,IMSUBC,ITYPA1,ITYPA2,ITYPA3,ITYPA4,NUMVAR,IWRITE,
     1YM9,NR9,NC9,VECT9,NVECT9,SCAL9,ITYP9,
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC1YMJUNK,YMJUN2,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CARRY OUT MATRIX     ARITHMETIC OPERATIONS
C              OF THE REAL DATA IN MATRICES YM1 AND YM2.
C
C     OPERATIONS--ADDITION
C                 SUBTRACTION
C                 MULTIPLICATION
C                 SOLUTION
C                 ITERATIVE SOLUTION
C                 INVERSE
C                 TRANSPOSE
C                 ADJOINT         
C                 CHARACTERISTIC EQUATION      (NOT YET IMPLEMENED)
C                 EIGENVALUES
C                 EIGENVECTORS
C                 RANK
C                 DETERMINANT
C                 PERMANENT                    (NOT YET IMPLEMENED)
C                 SPECTRAL NORM 
C                 SPECTRAL RADIUS
C                 NUMBER OF ROWS
C                 NUMBER OF COLUMNS
C                 SIMPLEX SOLUTION
C                 TRACE       
C                 SUBMATRIX  
C                 MINOR     
C                 COFACTOR 
C                 DEFINITION  
C                 EUCLIDEAN NORM 
C                 SINGULAR VALUE
C                 SINGULAR VALUE DECOMPOSITION
C                 ROW
C                 ELEMENT
C                 REPLACE ROW
C                 REPLACE ELEMENT
C                 AUGMENT
C                 DIAGONAL
C                 CHOLESKY DECOMPOSITION
C                 TRIDIAGONAL SOLVE
C                 TRIANGULAR SOLVE
C                 TRIANGULAR INVERSE
C
C                 VARIANCE-COVARIANCE MATRIX
C                 CORRELATION MATRIX
C                 PRINCIPLE COMPONENTS ...
C                 ... PRINCIPLE COMPONENT ...
C
C     EXAMPLES--LET M3 = MATRIX ADDITION M1 M2
C               LET M3 = MATRIX ADDITION M1 P1
C             --LET M3 = MATRIX SUBTRACTION M1 M2
C               LET M3 = MATRIX SUBTRACTION M1 P1
C             --LET M3 = MATRIX MULTIPLICATION M1 M2
C               LET M3 = MATRIX MULTIPLICATION M1 V1
C               LET M3 = MATRIX MULTIPLICATION M1 P1
C             --LET V3 = MATRIX SOLUTION M1 V2
C             --LET M3 = MATRIX INVERSE M1
C             --LET M3 = MATRIX TRANSPOSE M1
C             --LET M3 = MATRIX ADJOINT M1
C             --LET V3 = MATRIX CHARACTERISTIC EQUATION M1
C             --LET V3 = MATRIX EIGENVALUES M1
C             --LET P3 = MATRIX EIGENVECTORS M1
C             --LET P3 = MATRIX RANK M1
C             --LET P3 = MATRIX DETERMINANT M1
C             --LET P3 = MATRIX PERMANENT M1
C             --LET P3 = MATRIX SPECTRAL NORM M1
C             --LET P3 = MATRIX SPECTRAL RADIUS M1
C             --LET P3 = MATRIX NUMBER OF ROWS M1
C             --LET P3 = MATRIX NUMBER OF COLUMNS M1
C             --LET V4 = MATRIX SIMPLEX SOLUTION V1 M1 V2 V3
C             --LET P3 = MATRIX TRACE M1
C             --LET M3 = MATRIX SUBMATRIX M1 P1 P2
C             --LET P3 = MATRIX MINOR M1 P1 P2
C             --LET P3 = MATRIX COFACTOR M1 P1 P2
C             --LET M3 = MATRIX DEFINITION V1 P1 P2
C             --LET P3 = MATRIX EUCLIDEAN NORM M1
C             --LET V3 = MATRIX ROW M1 P1
C             --LET P3 = MATRIX ELEMENT M1 P1 P2
C             --LET M3 = MATRIX REPLACE ROW M1 V1 P1
C             --LET M3 = MATRIX REPLACE ELEMENT M1 P1 P2
C             --LET M3 = MATRIX AUGMENT M1
C             --LET V3 = MATRIX DIAGONAL M1
C             --LET M3 = DIAGONAL MATRIX V1
C             --LET M3 = VARIANCE-COVARIANCE MATRIX M1
C             --LET M3 = CORRELATION MATRIX M1
C             --LET M3 = PRINCIPLE COMPONENTS M1
C             --LET M3 = PRINCIPLE COMPONENTS EIGENVECTORS M1
C             --LET V3 = PRINCIPLE COMPONENTS EIGENVALUES M1
C             --LET V3 = ... PRINCIPLE COMPONENT M1
C             --LET V3 = ... PRINCIPLE COMPONENT EIGENVECTOR M1
C             --LET P3 = ... PRINCIPLE COMPONENT EIGENVALUE M1
C             --LET V3 = MATRIX SINGULAR VALUES M1
C             --LET M3 V3 M2 = MATRIX SINGULAR VALUE DECOMP M1
C             --LET M3 V3 M2 = MATRIX SINGULAR VALUE FACTOR M1
C             --LET M3 = CHOLESKY DECOMP M1
C             --LET V4 = TRIDIAGONAL SOLVE V1 V2 V3
C
C     INPUT  ARGUMENTS--YM1 (REAL MATRIX)
C                     --NR1
C                     --NC1
C                     --YM2 (REAL MATRIX)
C                     --NR2
C                     --NC2
C                     --YM3 (REAL MATRIX)
C                     --NR3
C                     --NC3
C                     --Y1  (REAL VECTOR)
C                     --N1
C                     --Y2  (REAL VECTOR)
C                     --N2
C                     --Y3  (REAL VECTOR)
C                     --N3
C                     --Y4  (REAL VECTOR)
C                     --N4
C     OUTPUT ARGUMENTS--YM9 (REAL MATRIX)
C                     --NR9
C                     --NC9
C                     --VECT9 (REAL VECTOR)
C                     --NVECT9
C                     --SCAL9 (REAL SCALAR)
C                     --ITYP9
C
C     NOTE--IT IS NOT PERMISSIBLE TO HAVE THE OUTPUT MATRIX YM9(.)
C           BEING IDENTICAL TO THE INPUT MATRIX YM1(.), YM2(.), OR YM3(.).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/10
C     ORIGINAL VERSION--SEPTEMBER 1987.
C     UPDATED         --AUGUST 1988  (VARIANCE-COVARIANCE MATRIX)
C     UPDATED         --AUGUST 1988  (CORRELATION MATRIX)
C     UPDATED         --AUGUST 1988  (PRINCIPLE COMPONENTS)
C     UPDATED         --AUGUST 1988  (... PRINCIPLE COMPONENTS)
C     UPDATED         --APRIL  1992  DEFINE D999
C     UPDATED         --JULY   1993  FOR MATRIX SOLUTION, DETERMINANT,
C                                    INVERSE, REPLACE NUMERICAL RECIPES
C                                    CODE WITH LINPACK CODE
C     UPDATED         --JULY   1993  EIGENVALUES AND EIGENVECTORS 
C                                    EXTENDED TO NON-SYMMETRIC CASE
C     UPDATED         --JULY   1993  IMPLEMENT RANK, ADJOINT, SINGULAR
C                                    VALUES, SINGULAR VALUE DECOMP.
C     UPDATED         --SEPT   1993  ROW, ELEMENT CASES
C     UPDATED         --OCTOB  1993  CHOLESKY DECOMPOSITION, REPLACE 
C                                    ROW, REPLACE ELEMENT, AUGMENT,
C                                    DIAGONAL, ADD ARGUMENT TO
C                                    MATRIX DEFINITION, TRIDIAGONAL
C                                    SOLVE.
C     UPDATED         --JANUARY  1998 RECODE TO MINIMIZE NUMBER OF
C                                     MATRICES NEEDED.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMCASE
      CHARACTER*4 IUPFLG
      CHARACTER*4 IMSUBC
      CHARACTER*4 ITYPA1
      CHARACTER*4 ITYPA2
      CHARACTER*4 ITYPA3
      CHARACTER*4 ITYPA4
      CHARACTER*4 IWRITE
      CHARACTER*4 ITYP9
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C-----DOUBLE PRECISION STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DNR1
      DOUBLE PRECISION DNC1
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      DOUBLE PRECISION D999
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION YM1(MAXROM,MAXCOM)
      DIMENSION YM2(MAXROM,MAXCOM)
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC DIMENSION YM3(MAXROM,MAXCOM)
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION Y4(*)
      DIMENSION YM9(MAXROM,MAXCOM)
CCCCC DIMENSION VECT9(MAXROM)
      DIMENSION VECT9(*)
C
CCCCC JANUARY 1998.  RECODE TO USE LESS MATRICES.
CCCCC DIMENSION YMJUNK(MAXROM,MAXCOM)
CCCCC DIMENSION YMJUN2(MAXROM,MAXCOM)
CCCCC DIMENSION INDEX(MAXROM)
CCCCC DIMENSION VJUNK(MAXROM)
CCCCC DIMENSION VJUNK2(MAXROM)
      DIMENSION INDEX(*)
CCCCC DIMENSION VJUNK(MAXOBV)
CCCCC DIMENSION VJUNK2(MAXOBV)
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='MATA'
      ISUBN2='R2  '
C
      IERROR='NO'
C
      IYS1=(-999)
      IYS2=(-999)
      IYS3=(-999)
      IYS23=(-999)
C
      NRJ=(-999)
      NCJ=(-999)
C
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992
      D999=(-999.0D0)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'TAR2')GOTO190
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4
   52 FORMAT('IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMCASE,IMSUBC
   53 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMVAR,IWRITE
   54 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)YS1,YS2,YS3,YS4
   55 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NR1,NC1
   61 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO69
      IF(NC1.LE.0)GOTO69
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO62I=1,NR1
      WRITE(ICOUT,63)I,(YM1(I,J),J=1,JMAX)
   63 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   69 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)NR2,NC2
   71 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO79
      IF(NC2.LE.0)GOTO79
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO72I=1,NR2
      WRITE(ICOUT,73)I,(YM2(I,J),J=1,JMAX)
   73 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   79 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NR3,NC3
   81 FORMAT('NR3,NC3 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR3.LE.0)GOTO89
      IF(NC3.LE.0)GOTO89
      JMAX=NC3
      IF(JMAX.GT.10)JMAX=10
      DO82I=1,NR3
      WRITE(ICOUT,83)I,(YM9(I,J),J=1,JMAX)
   83 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   89 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)N1
  111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO119
      DO112I=1,N1
      WRITE(ICOUT,113)I,Y1(I)
  113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  112 CONTINUE
  119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)N2
  121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO129
      DO122I=1,N2
      WRITE(ICOUT,123)I,Y2(I)
  123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  122 CONTINUE
  129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)N3
  131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO139
      DO132I=1,N3
      WRITE(ICOUT,133)I,Y3(I)
  133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  132 CONTINUE
  139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)N4
  141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO149
      DO142I=1,N4
      WRITE(ICOUT,143)I,Y4(I)
  143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  142 CONTINUE
  149 CONTINUE
C
  190 CONTINUE
C
C               **************************************************
C               **  CARRY OUT MATRIX     ARITHMETIC OPERATIONS  **
C               **************************************************
C
      DNR1=NR1
      DNC1=NC1
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK NUMBER OF INPUT OBSERVATIONS.   **
C               ********************************************
C
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NR1.LE.0)GOTO1100
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NC1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NR2.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NC2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NR3.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NC3.LE.0)GOTO1100
C
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1.AND.N1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2.AND.N2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3.AND.N3.LE.0)GOTO1100
C
      GOTO1190
C
 1100 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE INPUT NUMBER OF ROWS AND/OR COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      IN THE MATRIX AND/OR VECTOR FOR WHICH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('      THE MATRIX OPERATION IS TO BE COMPUTED')
      WRITE(ICOUT,1181)
 1181 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
C
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1)WRITE(ICOUT,1183)NR1,NC1
 1183 FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1)CALL DPWRST('XXX','BUG ')
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2)WRITE(ICOUT,1184)NR2,NC2
 1184 FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2)CALL DPWRST('XXX','BUG ')
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3)WRITE(ICOUT,1185)NR3,NC3
 1185 FORMAT('            MATRIX 3--',I8,' ROWS BY ',I8,' COLUMNS')
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3)CALL DPWRST('XXX','BUG ')
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1)WRITE(ICOUT,1186)N1
 1186 FORMAT('            VECTOR 1--',I8,' ROWS')
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1)CALL DPWRST('XXX','BUG ')
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2)WRITE(ICOUT,1187)N2
 1187 FORMAT('            VECTOR 2--',I8,' ROWS')
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2)CALL DPWRST('XXX','BUG ')
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3)WRITE(ICOUT,1188)N3
 1188 FORMAT('            VECTOR 3--',I8,' ROWS')
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3)CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1190 CONTINUE
C
C               *********************************
C               **  STEP 12--                  **
C               **  BRANCH TO THE PROPER CASE  **
C               *********************************
C
CCCCC JULY 1993.  ADD FOLLOWING 3 LINES
      IF(IMCASE.EQ.'MASV')GOTO5800
      IF(IMCASE.EQ.'MASD')GOTO5900
      IF(IMCASE.EQ.'MASF')GOTO6000
CCCCC SEPTEMBER 1993.  ADD FOLLOWING 2 LINES
      IF(IMCASE.EQ.'MARW')GOTO6100
      IF(IMCASE.EQ.'MAEL')GOTO6200
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      IF(IMCASE.EQ.'MACH')GOTO6300
      IF(IMCASE.EQ.'MAAU')GOTO6400
      IF(IMCASE.EQ.'MADI')GOTO6500
      IF(IMCASE.EQ.'DIMA')GOTO6600
      IF(IMCASE.EQ.'MARR')GOTO6700
      IF(IMCASE.EQ.'MARE')GOTO6800
      IF(IMCASE.EQ.'MATD')GOTO6900
      IF(IMCASE.EQ.'MATS')GOTO7000
      IF(IMCASE.EQ.'MATI')GOTO7100
      IF(IMCASE.EQ.'MAIS')GOTO7200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** INTERNAL ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      IMCASE NOT EQUAL TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      MASV, MASD, MASF, MARW, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      MAEL, MACH, MAAU, MADI, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      DIMA, MARR, MARE, MATD, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      MATS, MATI, MAIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1228)IMCASE
 1228 FORMAT('      IMCASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               ************************************************
C               **  STEP 58--                                 **
C               **  TREAT THE MATRIX SINGULAR VALUES CASE     **
C               ************************************************
C
CCCCC IMPLEMENTED JULY 1993.
 5800 CONTINUE
C
      IERR2=0
      AJOB=0.
      BJOB=0.
      AJOB=AJOB*BJOB
      CALL SSVDC(YM1,MAXROM,NR1,NC1,VECT9,Y1,YM1,MAXROM,
     1YM1,MAXROM,Y2,AJOB,IERR2)
C
      ITYP9='VECT'
      NVECT9=MIN(NR1,NC1)
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 59--                                 **
C               **  TREAT THE MATRIX SINGULAR VALUES          **
C               **  DECOMPOSITION CASE                        **
C               ************************************************
C
CCCCC IMPLEMENTED JULY 1993.
 5900 CONTINUE
C
      IF(NR1.LE.MAXCOM)GOTO5909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5901)
 5901 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5902)
 5902 FORMAT('      FOR MATRIX SINGULAR VALUE DECOMPOSITION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5903)
 5903 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5904)
 5904 FORMAT('      CAN NOT EXCEED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5905)
 5905 FORMAT('      THE MAXIMUM NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5906)
 5906 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5907)NR1
 5907 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5908)MAXCOM
 5908 FORMAT('            MAXIMUM NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5909 CONTINUE
      DO5922J=1,MAXCOM
      DO5921I=1,MAXROM
      YM9(I,J)=0.0
      YM2(I,J)=0.0
 5921 CONTINUE
 5922 CONTINUE
C
      IERR2=0
      AJOB=1.
      BJOB=1.
      AJOB=AJOB*BJOB
      NTEMP1=NR1
      NTEMP2=NC1
      CALL SSVDC(YM1,MAXROM,NTEMP1,NTEMP2,VECT9,Y1,YM9,MAXROM,
     1YM2,MAXROM,Y2,AJOB,IERR2)
C
      ITYP9='MATR'
      MM=NR1
      IF(MM.GT.NC1)MM=NC1
      NR9=NR1
      NC9=NR1
      NR2=NC1
      NC2=NC1
      NVECT9=MM
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 60--                                 **
C               **  TREAT THE MATRIX SINGULAR VALUES          **
C               **  FACTORIZATION CASE                        **
C               ************************************************
C
CCCCC IMPLEMENTED JULY 1993.
 6000 CONTINUE
C
      DO6022J=1,MAXCOM
      DO6021I=1,MAXROM
      YM9(I,J)=0.0
      YM2(I,J)=0.0
 6021 CONTINUE
 6022 CONTINUE
C
      IERR2=0
      AJOB=2.
      BJOB=1.
      AJOB=AJOB*BJOB
      NTEMP1=NR1
      NTEMP2=NC1
      CALL SSVDC(YM1,MAXROM,NTEMP1,NTEMP2,VECT9,Y1,YM9,MAXROM,
     1YM2,MAXROM,Y2,AJOB,IERR2)
C
      ITYP9='MATR'
      MM=NR1
      IF(MM.GT.NC1)MM=NC1
      NR9=NR1
      NC9=NC1
      NR2=NC1
      NC2=NC1
      NVECT9=MM
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 61--                                      **
C               **  TREAT THE MATRIX     ROW                 CASE  **
C               *****************************************************
C
 6100 CONTINUE
      IROWID=INT(YS2+0.5)
      IF(IROWID.LT.1 .OR. IROWID.GT.NR1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6101)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6102)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6103)
        WRITE(ICOUT,6104)NR1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6105)IROWID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6101 FORMAT('***** ERROR IN MATAR2--')
 6102 FORMAT('      FOR MATRIX ROW,')
 6103 FORMAT('      THE REQUESTED ROW IN THE MATRIX MUST BE BETWEEN')
 6104 FORMAT('      1 AND ',I8,'.  SUCH WAS NOT THE CASE HERE.')
 6105 FORMAT('      THE REQUESTED ROW NUMBER = ',I8)
C
      DO6120J=1,NC1
      VECT9(J)=YM1(IROWID,J)
 6120 CONTINUE
C
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 62--                                      **
C               **  TREAT THE MATRIX     ELEMENT             CASE  **
C               *****************************************************
C
 6200 CONTINUE
      IROWID=INT(YS2+0.5)
      ICOLID=INT(YS3+0.5)
      IF(IROWID.LT.1 .OR. IROWID.GT.NR1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6201)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6202)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6203)
        WRITE(ICOUT,6204)NR1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6205)IROWID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6201 FORMAT('***** ERROR IN MATAR2--')
 6202 FORMAT('      FOR MATRIX ELEMENT,')
 6203 FORMAT('      THE REQUESTED ROW IN THE MATRIX MUST BE BETWEEN')
 6204 FORMAT('      1 AND ',I8,'.  SUCH WAS NOT THE CASE HERE.')
 6205 FORMAT('      THE REQUESTED ROW NUMBER = ',I8)
C
      IF(ICOLID.LT.1 .OR. ICOLID.GT.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6211)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6212)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6213)
        WRITE(ICOUT,6214)NC1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6215)ICOLID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6211 FORMAT('***** ERROR IN MATAR2--')
 6212 FORMAT('      FOR MATRIX ELEMENT,')
 6213 FORMAT('      THE REQUESTED COLUMN IN THE MATRIX MUST BE')
 6214 FORMAT('      BETWEEN 1 AND ',I8,'.  SUCH WAS NOT THE CASE')
 6215 FORMAT('      HERE.  THE REQUESTED COLUMN NUMBER = ',I8)
C
      ITYP9='SCAL'
      SCAL9=YM1(IROWID,ICOLID)
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 63--                              **
C               **  TREAT THE MATRIX CHOLESKY DECOMP CASE  **
C               **  REFERENCE--LINPACK USER'S GUIDE        **
C               *********************************************
C
 6300 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO6309
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6302)
 6302 FORMAT('      FOR MATRIX CHOLESKY DECOMPOSITION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6303)
 6303 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6304)
 6304 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6305)
 6305 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6306)
 6306 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6307)NR1
 6307 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6308)NC1
 6308 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6309 CONTINUE
C
      CALL SPOCO(YM1,MAXROM,NR1,RCOND,Y1,INFO)
C
      IF(INFO.NE.0)THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6351)
 6351 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6352)
 6352 FORMAT('      FOR MATRIX CHOLESKY DECOMPOSITION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6353)
 6353 FORMAT('      THE INPUT MATRIX IS NOT SINGULAR.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      ENDIF
C
      WRITE(ICOUT,6361)RCOND
      CALL DPWRST('XXX','TEXT ')
 6361 FORMAT('THE RECIPROCAL CONDITION NUMBER FOR THE MATRIX = ',E15.7)
      IF(1.0+RCOND.EQ.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6371)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,6372)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      END IF
 6371 FORMAT('****** ERROR IN MATAR2 ********')
 6372 FORMAT('       THE INPUT MATRIX IS SINGULAR')
C
      DO6380I=1,NR1
      DO6382J=I,NR1
        YM9(J,I)=0.
        YM9(I,J)=YM1(I,J)
 6382 CONTINUE
 6380 CONTINUE
C
      ITYP9='MATR'
      NVECT9=NR1
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C
C               ******************************************************
C               **  STEP 64--                                       **
C               **  TREAT THE MATRIX AUGMENT CASE                   **
C               ******************************************************
C
 6400 CONTINUE
C
      IF(NR1.EQ.NR2)GOTO6409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6401)
 6401 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6402)
 6402 FORMAT('      FOR MATRIX AUGMENT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6403)
 6403 FORMAT('      THE NUMBER OF ROWS IN THE TWO MATRICES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6404)
 6404 FORMAT('      MUST BE EQUAL.  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6407)NR1
 6407 FORMAT('            NUMBER OF ROWS FOR MATRIX 1 =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6408)NR2
 6408 FORMAT('            NUMBER OF ROWS FOR MATRIX 2 =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6409 CONTINUE
C
      IF(NC1+NC2.LE.MAXCOM)GOTO6419
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6411)
 6411 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6412)
 6412 FORMAT('      FOR MATRIX AUGMENT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6413)
 6413 FORMAT('      THE NUMBER OF COLUMNS IN THE NEW MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6414)
 6414 FORMAT('      WOULD EXCEED THE ALLOWABLE MAXIMUM.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6417)NC1
 6417 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6418)NC2
 6418 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 2 =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6419 CONTINUE
C
      DO6430J=1,NC1
      DO6435I=1,NR1
      YM9(I,J)=YM1(I,J)
 6435 CONTINUE
 6430 CONTINUE
C
      DO6440J=1,NC2
      DO6445I=1,NR2
      J2=J+NC1
      YM9(I,J2)=YM2(I,J)
 6445 CONTINUE
 6440 CONTINUE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1+NC2
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 65--                                      **
C               **  TREAT THE MATRIX DIAGONAL                CASE  **
C               *****************************************************
C
 6500 CONTINUE
      IF(NR1.EQ.NC1)GOTO6509
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6501)
 6501 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6502)
 6502 FORMAT('      FOR MATRIX DIAGONAL,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6503)
 6503 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6504)
 6504 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6505)
 6505 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6506)
 6506 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6507)NR1
 6507 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6508)NC1
 6508 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6509 CONTINUE
C
      DO6520I=1,NC1
      VECT9(I)=YM1(I,I)
 6520 CONTINUE
C
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 66--                                      **
C               **  TREAT THE DIAGONAL MATRIX                CASE  **
C               *****************************************************
C
 6600 CONTINUE
C
      IF(N1.LE.MAXCOM)GOTO6609
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6601)
 6601 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6602)
 6602 FORMAT('      FOR DIAGONAL MATRIX,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6603)
 6603 FORMAT('      THE NUMBER OF ROWS IN THE VECTOR MUST BE LESS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6604)
 6604 FORMAT('      THAN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6606)
 6606 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6607)N1
 6607 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6609 CONTINUE
      DO6610J=1,N1
      DO6615I=1,N1
      YM9(I,J)=0.0
 6615 CONTINUE
 6610 CONTINUE
      DO6620I=1,N1
      YM9(I,I)=Y1(I)
 6620 CONTINUE
C
      ITYP9='MATR'
      NR9=N1
      NC9=N1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 67--                                      **
C               **  TREAT THE MATRIX REPLACE ROW             CASE  **
C               *****************************************************
C
 6700 CONTINUE
      IROWID=INT(YS3+0.5)
      IF(IROWID.LT.1 .OR. IROWID.GT.NR1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6701)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6702)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6703)
        WRITE(ICOUT,6704)NR1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6705)IROWID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6701 FORMAT('***** ERROR IN MATAR2--')
 6702 FORMAT('      FOR MATRIX REPLACE ROW,')
 6703 FORMAT('      THE REQUESTED ROW IN THE MATRIX MUST BE BETWEEN')
 6704 FORMAT('      1 AND ',I8,'.  SUCH WAS NOT THE CASE HERE.')
 6705 FORMAT('      THE REQUESTED ROW NUMBER = ',I8)
C
      IF(N2.NE.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6711)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6712)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6713)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6714)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6715)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6716)NC1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6717)N2
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6711 FORMAT('***** ERROR IN MATAR2--')
 6712 FORMAT('      FOR MATRIX REPLACE ROW,')
 6713 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX MUST EQUAL')
 6714 FORMAT('      THE NUMBER OF COLUMNS IN THE VECTOR.  SUCH WAS')
 6715 FORMAT('      NOT THE CASE HERE.')
 6716 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX = ',I8)
 6717 FORMAT('      THE NUMBER OF COLUMNS IN THE VECTOR = ',I8)
C
      DO6720J=1,NC1
      DO6725I=1,NR1
      YM9(I,J)=YM1(I,J)
 6725 CONTINUE
 6720 CONTINUE
      DO6730J=1,N2
      YM9(IROWID,J)=Y2(J)
 6730 CONTINUE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 68--                                      **
C               **  TREAT THE MATRIX REPLACE ELEMENT         CASE  **
C               *****************************************************
C
 6800 CONTINUE
      IROWID=INT(YS2+0.5)
      ICOLID=INT(YS3+0.5)
      IF(IROWID.LT.1 .OR. IROWID.GT.NR1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6801)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6802)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6803)
        WRITE(ICOUT,6804)NR1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6805)IROWID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6801 FORMAT('***** ERROR IN MATAR2--')
 6802 FORMAT('      FOR MATRIX REPLACE ELEMENT,')
 6803 FORMAT('      THE REQUESTED ROW IN THE MATRIX MUST BE BETWEEN')
 6804 FORMAT('      1 AND ',I8,'.  SUCH WAS NOT THE CASE HERE.')
 6805 FORMAT('      THE REQUESTED ROW NUMBER = ',I8)
C
      IF(ICOLID.LT.1 .OR. ICOLID.GT.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6811)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6812)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6813)
        WRITE(ICOUT,6814)NC1
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6815)ICOLID
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 6811 FORMAT('***** ERROR IN MATAR2--')
 6812 FORMAT('      FOR MATRIX REPLACE ELEMENT,')
 6813 FORMAT('      THE REQUESTED COLUMN IN THE MATRIX MUST BE')
 6814 FORMAT('      BETWEEN 1 AND ',I8,'.  SUCH WAS NOT THE CASE')
 6815 FORMAT('      HERE.  THE REQUESTED COLUMN NUMBER = ',I8)
C
      DO6820J=1,NC1
      DO6825I=1,NR1
      YM9(I,J)=YM1(I,J)
 6825 CONTINUE
 6820 CONTINUE
      YM9(IROWID,ICOLID)=YS4
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
C               *********************************************
C               **  STEP 69--                              **
C               **  TREAT THE TRIDIAGONAL SOLUTION   CASE  **
C               **  REFERENCE--LINPACK (CHAPTER 7)         **
C               *********************************************
C
 6900 CONTINUE
C
      IF((N1.EQ.N2).AND.(N2.EQ.N3).AND.(N3.EQ.N4))GOTO6909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6901)
 6901 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6902)
 6902 FORMAT('      FOR SOLVING A TRIDIAGONAL EQUATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6903)
 6903 FORMAT('      THE NUMBER OF ROWS IN THE FOUR INPUT VECTORS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6904)
 6904 FORMAT('      MUST BE EQUAL.  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6907)N1,N2,N3,N4
 6907 FORMAT('              NUMBER OF ROWS IN THE VECTORS = ',4(I8,1X))
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6909 CONTINUE
C
      CALL SGTSL(N1,Y1,Y2,Y3,Y4,INFO)
      IF(INFO.EQ.0)GOTO6919
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6911)
 6911 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6912)
 6912 FORMAT('      IN SOLVING A TRIDIAGONAL EQUATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6913)
 6913 FORMAT('      A ZERO PIVOT ELEMENT WAS DETECTED.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 6919 CONTINUE
C
      DO6920I=1,N1
      VECT9(I)=Y4(I)
 6920 CONTINUE
C
      ITYP9='VECT'
      NVECT9=N1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 70--                              **
C               **  TREAT THE TRIANGULAR SOLVE       CASE  **
C               **  REFERENCE--LINPACK (CHAPTER 6)         **
C               *********************************************
C
 7000 CONTINUE
C
      IF(NR1.EQ.N2)GOTO7009
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7001)
 7001 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7002)
 7002 FORMAT('      FOR SOLVING A MATRIX EQUATION SUCH AS A*X = B,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7003)
 7003 FORMAT('      THE NUMBER OF ROWS IN THE LEFT-SIDE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7004)
 7004 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7005)
 7005 FORMAT('      THE NUMBER OF ROWS IN THE RIGHT-SIDE VECTOR;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7006)
 7006 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7007)NR1
 7007 FORMAT('              NUMBER OF ROWS IN THE MATRIX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7008)N2
 7008 FORMAT('              NUMBER OF ROWS IN THE VECTOR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7009 CONTINUE
C
      IJOB=1
      DO7046I=1,NR1
      DO7047J=I+1,NC1
      IF(YM1(I,J).NE.0.0)GOTO7049
 7047 CONTINUE
 7046 CONTINUE
      IJOB=0
 7049 CONTINUE
C
      DO7051I=1,N2
      VECT9(I)=Y2(I)
 7051 CONTINUE
C
      CALL STRSL(YM1,MAXROM,NR1,VECT9,IJOB,INFO)
      IF(INFO.NE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7071)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,7072)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      END IF
 7071 FORMAT('****** ERROR IN MATAR2 ********')
 7072 FORMAT('       THE INPUT MATRIX IS SINGULAR')
C
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 71--                              **
C               **  TREAT THE TRIANGULAR INVERSE     CASE  **
C               **  REFERENCE--LINPACK (CHAPTER 6)         **
C               *********************************************
C
 7100 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO7109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7101)
 7101 FORMAT('***** ERROR IN MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7102)
 7102 FORMAT('      FOR TRIANGULAR INVERSE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7103)
 7103 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7104)
 7104 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7105)
 7105 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7106)
 7106 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7107)NR1
 7107 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7108)NC1
 7108 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7109 CONTINUE
C
      IJOB=11
      DO7126I=1,NR1
      DO7127J=I+1,NC1
      IF(YM1(I,J).NE.0.0)GOTO7129
 7127 CONTINUE
 7126 CONTINUE
      IJOB=10
 7129 CONTINUE
      CALL STRDI(YM1,MAXROM,NR1,Y1,IJOB,INFO)
      IF(INFO.NE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7171)
        CALL DPWRST('XXX','ERRO')
        WRITE(ICOUT,7172)
        CALL DPWRST('XXX','ERRO')
        IERROR='YES'
        GOTO9000
      END IF
 7171 FORMAT('****** ERROR IN MATAR2 ********')
 7172 FORMAT('       THE INPUT MATRIX IS SINGULAR')
C
      DO7181J=1,NC1
      DO7182I=1,NR1
      YM9(I,J)=YM1(I,J)
 7182 CONTINUE
 7181 CONTINUE
CCCCC END CHANGE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *********************************************
C               **  STEP 72--                              **
C               **  TREAT THE MATRIX ITERATIVE SOLUTION CASE*
C               **  REFERENCE--LINPACk (PAGE 1.9)          **
C               *********************************************
C
 7200 CONTINUE
C
      IF(NR1.EQ.N2)GOTO7209
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7201)
 7201 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7202)
 7202 FORMAT('      FOR SOLVING A MATRIX EQUATION SUCH AS A*X = B,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7203)
 7203 FORMAT('      THE NUMBER OF ROWS IN THE LEFT-SIDE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7204)
 7204 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7205)
 7205 FORMAT('      THE NUMBER OF ROWS IN THE RIGHT-SIDE VECTOR;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7206)
 7206 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7207)NR1
 7207 FORMAT('              NUMBER OF ROWS IN THE MATRIX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7208)N2
 7208 FORMAT('              NUMBER OF ROWS IN THE VECTOR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7209 CONTINUE
C
      DO7241J=1,NC1
      DO7242I=1,NR1
      YM2(I,J)=YM1(I,J)
 7242 CONTINUE
      VECT9(J)=Y2(J)
 7241 CONTINUE
C
      CALL SGEFA(YM2,MAXROM,NR1,INDEX,INFO)
      IF(INFO.NE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7271)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,7272)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
        GOTO9000
      END IF
 7271 FORMAT('****** ERROR IN MATAR2 ********')
 7272 FORMAT('       THE INPUT MATRIX IS SINGULAR')
C
      IJOB=0
      CALL SGESL(YM2,MAXROM,NR1,INDEX,VECT9,IJOB)
      XNORM=SASUM(NR1,VECT9,1)
      RELERR=0.0
      IF(XNORM.EQ.0.0)GOTO7295
      DO7280ITER=1,20
        DO7285I=1,NR1
          Y3(I)=SDSDOT(NR1,YM1(I,1),MAXROM,VECT9(1),1,-Y2(I))
 7285   CONTINUE
        CALL SGESL(YM2,MAXROM,NR1,INDEX,Y3,IJOB)
        DO7290I=1,NR1
          VECT9(I)=VECT9(I)-Y3(I)
 7290   CONTINUE
        RNORM=SASUM(NR1,Y3,1)
        IF(ITER.EQ.1)RELERR=RNORM/XNORM
        YS1=XNORM+RNORM
        IF(YS1.EQ.XNORM)GOTO7295
 7280 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7281)
      CALL DPWRST('XXX','ERRO ')
      WRITE(ICOUT,7282)
      CALL DPWRST('XXX','ERRO ')
      GOTO9000
 7281 FORMAT('****** ERROR IN MATARI ********')
 7282 FORMAT('       SOLUTION FAILED TO CONVERGE.')
C
 7295 CONTINUE
      ITYP9='VECT'
      NVECT9=NR1
      IF(IFEEDB.EQ.'OFF')GOTO7299
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7296)RCOND
      CALL DPWRST('XXX','TEXT ')
 7296 FORMAT('THE RELATIVE ERROR = ',E15.7)
 7299 CONTINUE
      IUPFLG='FULL'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'TAR2')GOTO9090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MATAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4
 9012 FORMAT('IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMCASE,IMSUBC
 9013 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMVAR,IWRITE
 9014 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)YS1,YS2,YS3,YS4
 9015 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IERROR
 9016 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IYS2,IYS3,IYS23,NRJ,NCJ
 9017 FORMAT('IYS2,IYS3,IYS23,NRJ,NCJ = ',5I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NR1,NC1
 9031 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO9039
      IF(NC1.LE.0)GOTO9039
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO9032I=1,NR1
      WRITE(ICOUT,9033)I,(YM1(I,J),J=1,JMAX)
 9033 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9039 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NR2,NC2
 9041 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9049
      IF(NC2.LE.0)GOTO9049
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO9042I=1,NR2
      WRITE(ICOUT,9043)I,(YM2(I,J),J=1,JMAX)
 9043 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9049 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NR9,NC9
 9051 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9059
      IF(NC9.LE.0)GOTO9059
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9055I=1,NR9
      WRITE(ICOUT,9056)I,(YM9(I,J),J=1,JMAX)
 9056 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9055 CONTINUE
 9059 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9111)N1
 9111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO9119
      DO9112I=1,N1
      WRITE(ICOUT,9113)I,Y1(I)
 9113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9112 CONTINUE
 9119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9121)N2
 9121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO9129
      DO9122I=1,N2
      WRITE(ICOUT,9123)I,Y2(I)
 9123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9122 CONTINUE
 9129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9131)N3
 9131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO9139
      DO9132I=1,N3
      WRITE(ICOUT,9133)I,Y3(I)
 9133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9132 CONTINUE
 9139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9141)N4
 9141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO9149
      DO9142I=1,N4
      WRITE(ICOUT,9143)I,Y4(I)
 9143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9142 CONTINUE
 9149 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9151)ITYP9,SCAL9
 9151 FORMAT('ITYP9,SCAL9 = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9161)NVECT9
 9161 FORMAT('NVECT9 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NVECT9.LE.0)GOTO9169
      DO9162I=1,NVECT9
      WRITE(ICOUT,9163)I,VECT9(I)
 9163 FORMAT('I,VECT9(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9162 CONTINUE
 9169 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9171)NR9,NC9
 9171 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9179
      IF(NC9.LE.0)GOTO9179
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9172I=1,NR9
      WRITE(ICOUT,9173)I,(YM9(I,J),J=1,JMAX)
 9173 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9172 CONTINUE
 9179 CONTINUE
C
      IF(IMCASE.NE.'MASS')GOTO9189
      WRITE(ICOUT,9181)NR2,NC2
 9181 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9189
      IF(NC2.LE.0)GOTO9189
      JMAX=NC2+1
      IF(JMAX.GT.10)JMAX=10
      NR2P1=NR2+1
      DO9182I=1,NR2P1
      WRITE(ICOUT,9183)I,(YM2(I,J),J=1,JMAX)
 9183 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9182 CONTINUE
CCCCC WRITE(ICOUT,9187)NR2,NLTZ,NGTZ,NEQZ
C9187 FORMAT('NR2,NLTZ,NGTZ,NEQZ = ',4I8)
      WRITE(ICOUT,9187)NR2
 9187 FORMAT('NR2 = ',I8)
      CALL DPWRST('XXX','BUG ')
 9189 CONTINUE
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MATAR3(YM1,NR1,NC1,YM2,NR2,NC2,NR3,NC3,
     1MAXROM,MAXCOM,MAXOBV,
     1Y1,N1,Y2,N2,Y3,N3,Y4,N4,Y5,
     1INDEX,
     1DTEMP1,DTEMP2,DTEMP3,
     1P,ABSE,RELE,AERROR,
     1YS1,YS2,YS3,YS4,
     1ASIG90,ASIG95,ASIG99,ASG995,
     1IMCASE,IUPFLG,IMSUBC,ITYPA1,ITYPA2,ITYPA3,ITYPA4,NUMVAR,IWRITE,
CCCCC MAY 2002.  ADD ISEED ARGUMENT
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1YM9,NR9,NC9,VECT9,NVECT9,SCAL9,ITYP9,
     1ICASS7,
CCCCC MARCH 2006: FOLLOWING FOR MATRIX BIN CASE
     1IRELAT,CLWID,XSTART,XSTOP,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CARRY OUT MATRIX     ARITHMETIC OPERATIONS
C              OF THE REAL DATA IN MATRICES YM1 AND YM2.
C              ADD SOME ADDITIONAL FUNCTIONALITY
C
C     OPERATIONS--QUADRATIC FORM (X'MX)  (DONE)
C                 1-SAMPLE HOTELLING T-SQUARE (DONE)
C                 2-SAMPLE HOTELLING T-SQUARE (DONE)
C                 POOLED SAMPLE VARIANCE-COVARIANCE MATRIX (DONE)
C                 MATRIX <ROW/COLUMN> SCALE  (DONE)
C                 <ROW/COLUMN> <STATISTIC>   (DONE)
C                 PARTITION    <STATISTIC>   (DONE)
C                 MATRIX    <STATISTIC>      (DONE)
C                 MATRIX  BIN                (DONE)
C                 EUCLIDEAN <ROW/COLUMN> DISTANCE  (DONE)
C                 CHEBYCHEV <ROW/COLUMN> DISTANCE  (DONE)
C                 L1 NORM <ROW/COLUMN> DISTANCE  (DONE)
C                 MINKOWSKY <ROW/COLUMN> DISTANCE  (DONE)
C                 MAHALANOBIS <ROW/COLUMN> DISTANCE  (DONE)
C                 MATRIX MEAN (I.E., GRAND MEAN) (DONE)
C                 MATRIX SUM (DONE)
C                 MATRIX ADD ROW (DONE)
C                 MATRIX DELETE ROW (DONE)
C                 LINEAR COMBINATION (DONE)
C                 VECTOR TIMES TRANSPOSE (DONE)
C                 MATRIX GROUP MEAN (DONE)
C                 MATRIX GROUP STANDARD DEVIATION (DONE)
C                 CATCHER MATRIX (DONE)
C                 MULTIVARIATE NORMAL RANDOM NUMBERS (DONE)
C                 MULTINOMIAL RANDOM NUMBERS (DONE)
C                 MULTINOMIAL PDF (DONE)
C                 XTXINV MATRIX (DONE)
C                 VARIANCE INFLATION FACTORS (DONE)
C                 CONDITION INDICES (DONE)
C                 CREATE MATRIX (DONE)
C                 QR DECOMPOSITION (NOT DONE)
C                 PSUEDO INVERSE (NOT DONE)
C                 WISHART RANDOM NUMBERS (DONE)
C                 INDEPENDENT UNIFORM RANDOM NUMBERS (DONE)
C                 CORRELATED UNIFORM RANDOM NUMBERS (DONE)
C                 MULTIVARIATE NORMAL CDF (DONE)
C                 DIRICHLET RANDOM NUMBERS (DONE)
C                 MATRIX BIN (DONE)
C
C     EXAMPLES--LET A1 = QUADRATIC FORM M X
C             --LET A1 = HOTELLING T-SQUARE M U0
C             --LET Y1 = MATRIX ROW MEAN M
C               LET Y1 = MATRIX COLUMN MEAN M
C             --LET P1 = PSUEDO INVERSE M
C             --LET Q R = QR DECOMPOSITION M
C
C     INPUT  ARGUMENTS--YM1 (REAL MATRIX)
C                     --NR1
C                     --NC1
C                     --YM2 (REAL MATRIX)
C                     --NR2
C                     --NC2
C                     --YM3 (REAL MATRIX)
C                     --NR3
C                     --NC3
C                     --Y1  (REAL VECTOR)
C                     --N1
C                     --Y2  (REAL VECTOR)
C                     --N2
C                     --Y3  (REAL VECTOR)
C                     --N3
C                     --Y4  (REAL VECTOR)
C                     --N4
C     OUTPUT ARGUMENTS--YM9 (REAL MATRIX)
C                     --NR9
C                     --NC9
C                     --VECT9 (REAL VECTOR)
C                     --NVECT9
C                     --SCAL9 (REAL SCALAR)
C                     --ITYP9
C
C     NOTE--IT IS NOT PERMISSIBLE TO HAVE THE OUTPUT MATRIX YM9(.)
C           BEING IDENTICAL TO THE INPUT MATRIX YM1(.), YM2(.), OR YM3(.).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--98/06
C     ORIGINAL VERSION--JUNE      1998.
C     UPDATED         --MAY       2002. MULTIVARIATE NORM RAND NUMB
C     UPDATED         --MAY       2002. MULTINOMIAL RAND NUMB
C     UPDATED         --MAY       2002. WISHART RAND NUMB
C     UPDATED         --JUNE      2002. CATCHER MATRIX
C     UPDATED         --JUNE      2002. XTXINV MATRIX
C     UPDATED         --JUNE      2002. VARIANCE INFLATION FACTORS
C     UPDATED         --JUNE      2002. CONDITION NUMBERS
C     UPDATED         --JUNE      2002. CREATE MATRIX
C     UPDATED         --AUGUST    2002. USE "CMPSTA" TO COMPUTE
C                                       STATISTIC FOR
C                                       MATRIX <ROW/COLU> <STAT>
C     UPDATED         --APRIL     2003. FIX WISHART RANDOM NUMBERS
C     UPDATED         --APRIL     2003. MULTIVARIATE T RANDOM NUMBERS
C     UPDATED         --APRIL     2003. INDPENDENT UNIFORM RANDOM NUMB
C     UPDATED         --APRIL     2003. MULTIVARIATE NORMAL CDF
C     UPDATED         --APRIL     2003. MULTIVARIATE T CDF
C     UPDATED         --APRIL     2003. ARGUMENT LIST TO CMPSTA
C     UPDATED         --SEPTEMBER 2003. CORRELATED UNIFORM RANDOM NUMB
C     UPDATED         --JUNE      2005. MATRIX PARTITION <STAT>
C     UPDATED         --JUNE      2005. MATRIX <STAT>
C     UPDATED         --JULY      2005. MATRIX PARTITION <STAT>
C                                       EXTENDED TO UNEQUAL PARTITION
C                                       CASE
C     UPDATED         --MARCH     2006. MATRIX BIN
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 IMCASE
      CHARACTER*4 ICASS7
      CHARACTER*4 IUPFLG
      CHARACTER*4 IMSUBC
      CHARACTER*4 ITYPA1
      CHARACTER*4 ITYPA2
      CHARACTER*4 ITYPA3
      CHARACTER*4 ITYPA4
      CHARACTER*4 IWRITE
      CHARACTER*4 ITYP9
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
CCCCC CHARACTER*4 IHP
CCCCC CHARACTER*4 IHP2
CCCCC CHARACTER*4 IHWUSE
CCCCC CHARACTER*4 MESSAG
C
      CHARACTER*4 IRELAT
C
      CHARACTER*4 ICASE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
CCCCC MAY 2002. ADD FOLLOWING LINE
      LOGICAL LTF
C
C-----DOUBLE PRECISION STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DNR1
      DOUBLE PRECISION DNC1
      DOUBLE PRECISION D999
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION ABSEPS
      DOUBLE PRECISION RELEPS
      DOUBLE PRECISION VALS
      DOUBLE PRECISION ERRS
      DOUBLE PRECISION DN
      DOUBLE PRECISION DNORM
      DOUBLE PRECISION DLNPDF
      DOUBLE PRECISION DLNGAM
C
C---------------------------------------------------------------------
C
      DIMENSION YM1(MAXROM,MAXCOM)
      DIMENSION YM2(MAXROM,MAXCOM)
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y3(*)
      DIMENSION Y4(*)
      DIMENSION Y5(*)
      DIMENSION YM9(MAXROM,MAXCOM)
      DIMENSION VECT9(*)
      DIMENSION INDEX(*)
      DOUBLE PRECISION DTEMP1(*)
      DOUBLE PRECISION DTEMP2(*)
      DOUBLE PRECISION DTEMP3(*)
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
      INCLUDE 'DPCOST.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='MATA'
      ISUBN2='R3  '
C
      IERROR='NO'
C
      IYS1=(-999)
      IYS2=(-999)
      IYS3=(-999)
      IYS23=(-999)
C
      NRJ=(-999)
      NCJ=(-999)
C
      D999=(-999.0D0)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ATR3')GOTO190
C
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4
   52 FORMAT('IBUGA3,ISUBRO,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMCASE,IMSUBC
   53 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMVAR,IWRITE
   54 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)YS1,YS2,YS3,YS4
   55 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NR1,NC1
   61 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO69
      IF(NC1.LE.0)GOTO69
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO62I=1,NR1
      WRITE(ICOUT,63)I,(YM1(I,J),J=1,JMAX)
   63 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
   69 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)NR2,NC2
   71 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO79
      IF(NC2.LE.0)GOTO79
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO72I=1,NR2
      WRITE(ICOUT,73)I,(YM2(I,J),J=1,JMAX)
   73 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
   79 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NR3,NC3
   81 FORMAT('NR3,NC3 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR3.LE.0)GOTO89
      IF(NC3.LE.0)GOTO89
      JMAX=NC3
      IF(JMAX.GT.10)JMAX=10
      DO82I=1,NR3
      WRITE(ICOUT,83)I,(YM9(I,J),J=1,JMAX)
   83 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
   82 CONTINUE
   89 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)N1
  111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO119
      DO112I=1,N1
      WRITE(ICOUT,113)I,Y1(I)
  113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  112 CONTINUE
  119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)N2
  121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO129
      DO122I=1,N2
      WRITE(ICOUT,123)I,Y2(I)
  123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  122 CONTINUE
  129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)N3
  131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO139
      DO132I=1,N3
      WRITE(ICOUT,133)I,Y3(I)
  133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  132 CONTINUE
  139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)N4
  141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO149
      DO142I=1,N4
      WRITE(ICOUT,143)I,Y4(I)
  143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  142 CONTINUE
  149 CONTINUE
C
  190 CONTINUE
C
C               **************************************************
C               **  CARRY OUT MATRIX     ARITHMETIC OPERATIONS  **
C               **************************************************
C
      DNR1=NR1
      DNC1=NC1
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK NUMBER OF INPUT OBSERVATIONS.   **
C               ********************************************
C
      IF(IMCASE.EQ.'CRMA')GOTO8500
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NR1.LE.0)GOTO1100
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1.AND.NC1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NR2.LE.0)GOTO1100
      IF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2.AND.NC2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NR3.LE.0)GOTO1100
      IF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3.AND.NC3.LE.0)GOTO1100
C
      IF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1.AND.N1.LE.0)GOTO1100
      IF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2.AND.N2.LE.0)GOTO1100
      IF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3.AND.N3.LE.0)GOTO1100
C
      GOTO1190
C
 1100 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE INPUT NUMBER OF ROWS AND/OR COLUMNS IN THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MATRIX AND/OR VECTOR FOR WHICH THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('      OPERATION IS TO BE COMPUTED MUST BE 1 OR')
      WRITE(ICOUT,1182)
 1182 FORMAT('      LARGER;  SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
C
      IF(ITYPA1.EQ.'MATR'.AND.NUMVAR.GE.1)THEN
        WRITE(ICOUT,1183)NR1,NC1
 1183   FORMAT('            MATRIX 1--',I8,' ROWS BY ',I8,' COLUMNS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ITYPA2.EQ.'MATR'.AND.NUMVAR.GE.2)THEN
        WRITE(ICOUT,1184)NR2,NC2
 1184   FORMAT('            MATRIX 2--',I8,' ROWS BY ',I8,' COLUMNS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ITYPA3.EQ.'MATR'.AND.NUMVAR.GE.3)THEN
        WRITE(ICOUT,1185)NR3,NC3
 1185   FORMAT('            MATRIX 3--',I8,' ROWS BY ',I8,' COLUMNS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ITYPA1.EQ.'VARI'.AND.NUMVAR.GE.1)THEN
        WRITE(ICOUT,1186)N1
 1186   FORMAT('            VECTOR 1--',I8,' ROWS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ITYPA2.EQ.'VARI'.AND.NUMVAR.GE.2)THEN
        WRITE(ICOUT,1187)N2
 1187   FORMAT('            VECTOR 2--',I8,' ROWS')
        CALL DPWRST('XXX','BUG ')
      ELSEIF(ITYPA3.EQ.'VARI'.AND.NUMVAR.GE.3)THEN
        WRITE(ICOUT,1188)N3
 1188   FORMAT('            VECTOR 3--',I8,' ROWS')
        CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
 1190 CONTINUE
C
C               *********************************
C               **  STEP 12--                  **
C               **  BRANCH TO THE PROPER CASE  **
C               *********************************
C
      IF(IMCASE.EQ.'MPVC')GOTO5600
      IF(IMCASE.EQ.'MQFO')GOTO5800
      IF(IMCASE.EQ.'MHT1')GOTO5900
      IF(IMCASE.EQ.'MHT2')GOTO5700
      IF(IMCASE.EQ.'MROW')GOTO6000
      IF(IMCASE.EQ.'MCOL')GOTO6100
C
      IF(IMCASE.EQ.'MDER')THEN
        ICASE='ROW '
        GOTO6200
      ENDIF
      IF(IMCASE.EQ.'MDEC')THEN
        ICASE='COLU'
        GOTO6200
      ENDIF
C
      IF(IMCASE.EQ.'MRSC')THEN
        ICASE='ROW '
        GOTO6500
      ENDIF
      IF(IMCASE.EQ.'MCSC')THEN
        ICASE='COLU'
        GOTO6500
      ENDIF
C
      IF(IMCASE.EQ.'MDMR')THEN
        ICASE='ROW '
        GOTO6600
      ENDIF
      IF(IMCASE.EQ.'MDMC')THEN
        ICASE='COLU'
        GOTO6600
      ENDIF
C
      IF(IMCASE.EQ.'MDKR')THEN
        ICASE='ROW '
        GOTO6700
      ENDIF
      IF(IMCASE.EQ.'MDKC')THEN
        ICASE='COLU'
        GOTO6700
      ENDIF
C
      IF(IMCASE.EQ.'MDBR')THEN
        ICASE='ROW '
        GOTO6800
      ENDIF
      IF(IMCASE.EQ.'MDBC')THEN
        ICASE='COLU'
        GOTO6800
      ENDIF
C
      IF(IMCASE.EQ.'MDCR')THEN
        ICASE='ROW '
        GOTO6900
      ENDIF
      IF(IMCASE.EQ.'MDCC')THEN
        ICASE='COLU'
        GOTO6900
      ENDIF
C
      IF(IMCASE.EQ.'MQRD')GOTO6300
      IF(IMCASE.EQ.'MPIN')GOTO6400
      IF(IMCASE.EQ.'MAMM')GOTO7000
      IF(IMCASE.EQ.'MSUM')GOTO7030
      IF(IMCASE.EQ.'MAAR')GOTO7100
      IF(IMCASE.EQ.'MADR')GOTO7200
      IF(IMCASE.EQ.'MADM')GOTO7300
      IF(IMCASE.EQ.'MALC')GOTO7400
      IF(IMCASE.EQ.'MAVT')GOTO7500
      IF(IMCASE.EQ.'MAGM')GOTO7600
      IF(IMCASE.EQ.'MAGS')GOTO7700
      IF(IMCASE.EQ.'MVRN')GOTO7800
      IF(IMCASE.EQ.'MURN')GOTO7900
      IF(IMCASE.EQ.'MPDF')GOTO7950
      IF(IMCASE.EQ.'WIRN')GOTO8000
      IF(IMCASE.EQ.'MACA')GOTO8100
      IF(IMCASE.EQ.'XTXI')GOTO8200
      IF(IMCASE.EQ.'VINF')GOTO8300
      IF(IMCASE.EQ.'CIND')GOTO8400
      IF(IMCASE.EQ.'CRMA')GOTO8500
      IF(IMCASE.EQ.'IURN')GOTO8600
      IF(IMCASE.EQ.'NCDF')GOTO8700
      IF(IMCASE.EQ.'TCDF')GOTO8800
      IF(IMCASE.EQ.'TCDF')GOTO8800
      IF(IMCASE.EQ.'MTRN')GOTO8900
      IF(IMCASE.EQ.'DIRN')GOTO8950
      IF(IMCASE.EQ.'DPDF')GOTO9300
      IF(IMCASE.EQ.'DLPD')GOTO9300
      IF(IMCASE.EQ.'INRN')GOTO9400
      IF(IMCASE.EQ.'MPAR')GOTO9500
      IF(IMCASE.EQ.'MGRA')GOTO9600
      IF(IMCASE.EQ.'MATB')GOTO9700
      IF(IMCASE.EQ.'MARB')GOTO9700
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** INTERNAL ERROR IN MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      IMCASE NOT EQUAL TO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      MQFO, MHT2, MRxx, MCxx, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      MQRD, MPIN ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C               *******************************************************
C               **  STEP 56--                                        **
C               **  TREAT THE POOLED VARIANCE-COVARIANCE MATRIX  CASE**
C               *******************************************************
C
 5600 CONTINUE
C
      IF(ITYPA2.EQ.'VARI')GOTO5650
C
      IF(NC1.EQ.NC2)GOTO5609
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5601)
 5601 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5602)
 5602 FORMAT('      FOR THE POOLED VARIANCE-COVARIANCE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5603)
 5603 FORMAT('      THE NUMBER OF COLUMNS FOR THE TWO MATRICES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5604)
 5604 FORMAT('      MUST BE EQUAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5606)
 5606 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5607)NC1
 5607 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 1  =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5608)NC2
 5608 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 2  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5609 CONTINUE
C
      CALL VARPOO(YM1,YM2,YM9,MAXROM,MAXCOM,NR1,NC1,NR2,
     1DTEMP1,IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NC1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
 5650 CONTINUE
C
      IF(NR1.EQ.N2)GOTO5659
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5651)
 5651 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5652)
 5652 FORMAT('      FOR THE POOLED VARIANCE-COVARIANCE COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5653)
 5653 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5654)
 5654 FORMAT('      MUST EQUAL THE NUMBER OF ROWS IN THE GROUP-ID ',
     1'VARIABLE..')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5656)
 5656 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5657)NC1
 5657 FORMAT('            NUMBER OF ROWS FOR MATRIX             =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5658)NC2
 5658 FORMAT('            NUMBER OF ROWS FOR GROUP ID VARIABLE  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5659 CONTINUE
C
      CALL VARPO2(YM1,YM2,YM9,MAXROM,MAXCOM,NR1,NC1,MAXROM,
     1Y2,Y3,INDEX,NK,DTEMP1,IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NC1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 57--                                        **
C               **  TREAT THE MATRIX 2-SAMPLE HOTELLING T-SQUARE CASE**
C               *******************************************************
C
 5700 CONTINUE
C
      IF(NC1.EQ.NC2)GOTO5709
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5701)
 5701 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5702)
 5702 FORMAT('      FOR THE 2-SAMPLE HOTELLING T-SQUARE TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5703)
 5703 FORMAT('      THE NUMBER OF COLUMNS FOR THE TWO MATRICES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5704)
 5704 FORMAT('      MUST BE EQUAL.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5706)
 5706 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5707)NC1
 5707 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 1  =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5708)NC2
 5708 FORMAT('            NUMBER OF COLUMNS FOR MATRIX 2  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5709 CONTINUE
C
      CALL HTTSQ2(YM1,YM2,YM9,MAXROM,MAXCOM,NR1,NR2,NC1,
     1TSTAT,ASIG90,ASIG95,ASIG99,ASG995,
     1DTEMP1,Y1,Y2,Y3,INDEX,
     1IBUGA3,IERROR)
C
      SCAL9=TSTAT
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 58--                                 **
C               **  TREAT THE MATRIX QUADRATIC FORM  CASE     **
C               **  QUADRATIC FORM = x'Mx                     **
C               **  x IS A VECTOR AND M IS A MATRIX           **
C               ************************************************
C
 5800 CONTINUE
C
      IF(NR1.EQ.NC1)GOTO5809
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5801)
 5801 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5802)
 5802 FORMAT('      FOR QUADRATIC FORM,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5803)
 5803 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5804)
 5804 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5805)
 5805 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5806)
 5806 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5807)NR1
 5807 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5808)NC1
 5808 FORMAT('            NUMBER OF COLUMNS =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5809 CONTINUE
C
 5850 CONTINUE
      IF(N2.EQ.NR1)GOTO5859
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5851)
 5851 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5852)
 5852 FORMAT('      FOR QUADRATIC FORM, THE NUMBER OF ROWS IN THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5855)
 5855 FORMAT('      MATRIX MUST = NUMBER OF ROWS IN THE VECTOR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5856)
 5856 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5858)NR1,N1
 5858 FORMAT('          MATRIX --',I8,' ROWS, VECTOR  ',I8,' COLUMNS')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5859 CONTINUE
C
      CALL QUAFRM(YM1,MAXROM,MAXCOM,NR1,NC1,Y2,IWRITE,SCAL9,
     1IBUGA3,IERROR)
C
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 59--                                        **
C               **  TREAT THE MATRIX 1-SAMPLE HOTELLING T-SQUARE CASE**
C               **  H0: U=U0                                         **
C               **  T-SQUARE = N*(XBAR-U0)'*SINV*(XBAR-U0)           **
C               **  WHERE SINV = SAMPLE VARIANCE-COVARIANCE MATRIX   **
C               *******************************************************
C
 5900 CONTINUE
C
      IF(NC1.EQ.N2)GOTO5909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5901)
 5901 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5902)
 5902 FORMAT('      FOR THE 1-SAMPLE HOTELLING T-SQUARE TEST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5903)
 5903 FORMAT('      THE NUMBER OF COLUMNS IN THE MATRIX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5904)
 5904 FORMAT('      MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5905)
 5905 FORMAT('      THE NUMBER OF ROWS IN THE MEAN VECTOR;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5906)
 5906 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5907)NC1
 5907 FORMAT('            NUMBER OF COLUMNS FOR MATRIX    =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5908)N2
 5908 FORMAT('            NUMBER OF ROWS FOR MEAN VECTOR  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5909 CONTINUE
C
      CALL HTTSQ1(YM1,YM2,MAXROM,MAXCOM,NR1,NC1,
     1TSTAT,ASIG90,ASIG95,ASIG99,ASG995,
     1DTEMP1,Y2,Y1,Y3,INDEX,
     1IBUGA3,IERROR)
C
      SCAL9=TSTAT
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 60--                                 **
C               **  TREAT THE MATRIX ROW STATISTIC CASE       **
C               ************************************************
C
CCCCC IMPLEMENTED JULY 1993.
 6000 CONTINUE
C
      IWRITE='OFF'
      MAXNXT=MAXOBV
C
      DO6010I=1,NR1
        DO6015J=1,NC1
          Y1(J)=YM1(I,J)
 6015   CONTINUE
        ASTAT=0.0
        CALL CMPSTA(
     1  Y1,Y2,Y3,Y4,Y5,MAXNXT,NC1,NC1,NUMV2,ICASS7,
     1  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1  IQUAME,IQUASE,
     1  ASTAT,
     1  ISUBRO,IBUGA3,IERROR)
        VECT9(I)=ASTAT
 6010 CONTINUE
C
      ITYP9='VECT'
      NR9=1
      NC9=1
      NVECT9=NR1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 61--                                      **
C               **  TREAT THE MATRIX COLUMN STATISTIC        CASE  **
C               *****************************************************
C
 6100 CONTINUE
C
      IWRITE='OFF'
      MAXNXT=MAXOBV
C
      DO6110I=1,NC1
        DO6115J=1,NR1
          Y1(J)=YM1(J,I)
 6115   CONTINUE
        ASTAT=0.0
        CALL CMPSTA(
     1  Y1,Y2,Y3,Y4,Y5,MAXNXT,NR1,NR1,NUMV2,ICASS7,
     1  ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1  IQUAME,IQUASE,
     1  ASTAT,
     1  ISUBRO,IBUGA3,IERROR)
        VECT9(I)=ASTAT
 6110 CONTINUE
C
      ITYP9='VECT'
      NR9=1
      NC9=1
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 62--                                      **
C               **  TREAT THE MATRIX EUCLIDEAN DISTANCE      CASE  **
C               *****************************************************
C
 6200 CONTINUE
C
      IF(ICASE.EQ.'ROW '.AND.NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6211)
 6211   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6213)
 6213   FORMAT('      FOR EUCLIDEAN ROW DISTANCES, THE NUMBER OF ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6215)NR1
 6215   FORMAT('      CREATED COLUMNS, ',I8,', WOULD EXCEED THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6217)MAXCOM
 6217   FORMAT('      MAXIMUM NUMBER OF ALLOWED COLUMNS,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IWRITE='OFF'
      CALL EUCDIS(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      IF(ICASE.EQ.'ROW')THEN
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ELSEIF(ICASE.EQ.'COLU')THEN
        NR9=NC1
        NC9=NC1
        IUPFLG='FULL'
      ELSE
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ENDIF
      GOTO9000
C
 6250 CONTINUE
      GOTO9000
C
C               *********************************************
C               **  STEP 63--                              **
C               **  TREAT THE MATRIX QR       DECOMP CASE  **
C               **  REFERENCE--LINPACK USER'S GUIDE        **
C               *********************************************
C
 6300 CONTINUE
C
CCCCC IF(NR1.LE.MAXCOM)GOTO6309
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN MATAR2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6302)
 6302 FORMAT('      FOR MATRIX SINGULAR VALUE DECOMPOSITION,')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6303)
 6303 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6304)
 6304 FORMAT('      CAN NOT EXCEED ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6305)
 6305 FORMAT('      THE MAXIMUM NUMBER OF COLUMNS IN THE MATRIX;')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6306)
 6306 FORMAT('      SUCH WAS NOT THE CASE HERE.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6307)NR1
 6307 FORMAT('            NUMBER OF ROWS    =',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6308)MAXCOM
 6308 FORMAT('            MAXIMUM NUMBER OF COLUMNS =',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
C
 6309 CONTINUE
      DO6322J=1,MAXCOM
      DO6321I=1,MAXROM
      YM9(I,J)=0.0
      YM2(I,J)=0.0
 6321 CONTINUE
 6322 CONTINUE
C
      IERR2=0
      AJOB=1.
      BJOB=1.
      AJOB=AJOB*BJOB
      NTEMP1=NR1
      NTEMP2=NC1
      CALL SSVDC(YM1,MAXROM,NTEMP1,NTEMP2,VECT9,Y1,YM9,MAXROM,
     1YM2,MAXROM,Y2,AJOB,IERR2)
C
      ITYP9='MATR'
      MM=NR1
      IF(MM.GT.NC1)MM=NC1
      NR9=NR1
      NC9=NR1
      NR2=NC1
      NC2=NC1
      NVECT9=MM
      IUPFLG='FULL'
      GOTO9000
C
C               ******************************************************
C               **  STEP 64--                                       **
C               **  TREAT THE MATRIX PSUEDO INVERSE         CASE    **
C               ******************************************************
C
 6400 CONTINUE
C
      GOTO9000
C
C               *****************************************************
C               **  STEP 65--                                      **
C               **  TREAT THE MATRIX SCALE                   CASE  **
C               *****************************************************
C
 6500 CONTINUE
C
      IWRITE='OFF'
      CALL MATSCA(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,Y1,Y2,Y3,
     1IMATSC,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 66--                                      **
C               **  TREAT THE MATRIX MAHALONOBIS DISTANCE    CASE  **
C               *****************************************************
C
 6600 CONTINUE
C
      IF(ICASE.EQ.'ROW '.AND.NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6611)
 6611   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6613)
 6613   FORMAT('      FOR MAHALANOBIS ROW DISTANCES, THE NUMBER OF ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6615)NR1
 6615   FORMAT('      CREATED COLUMNS, ',I8,', WOULD EXCEED THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6617)MAXCOM
 6617   FORMAT('      MAXIMUM NUMBER OF ALLOWED COLUMNS,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IWRITE='OFF'
      CALL MAHDIS(YM1,YM2,YM9,MAXROM,MAXCOM,NR1,NC1,
     1Y1,Y2,INDEX,DTEMP1,
     1ICASE,IWRITE,IBUGA3,IERROR)
C
      ITYP9='MATR'
      IF(ICASE.EQ.'ROW')THEN
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ELSEIF(ICASE.EQ.'COLU')THEN
        NR9=NC1
        NC9=NC1
        IUPFLG='FULL'
      ELSE
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ENDIF
      GOTO9000
C
C
C               *****************************************************
C               **  STEP 67--                                      **
C               **  TREAT THE MATRIX MINKOWSKY DISTANCE      CASE  **
C               *****************************************************
C
 6700 CONTINUE
C
      IF(ICASE.EQ.'ROW '.AND.NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6711)
 6711   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6713)
 6713   FORMAT('      FOR MINKOWSKY ROW DISTANCES, THE NUMBER OF ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6715)NR1
 6715   FORMAT('      CREATED COLUMNS, ',I8,', WOULD EXCEED THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6717)MAXCOM
 6717   FORMAT('      MAXIMUM NUMBER OF ALLOWED COLUMNS,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IWRITE='OFF'
      CALL MINDIS(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,P,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      IF(ICASE.EQ.'ROW')THEN
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ELSEIF(ICASE.EQ.'COLU')THEN
        NR9=NC1
        NC9=NC1
        IUPFLG='FULL'
      ELSE
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ENDIF
      GOTO9000
C
C               *****************************************************
C               **  STEP 68--                                      **
C               **  TREAT THE MATRIX BLOCK (= L1 NORM) DISTANCE CASE **
C               *****************************************************
C
 6800 CONTINUE
C
      IF(ICASE.EQ.'ROW '.AND.NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6811)
 6811   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6813)
 6813   FORMAT('      FOR BLOCK ROW DISTANCES, THE NUMBER OF ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6815)NR1
 6815   FORMAT('      CREATED COLUMNS, ',I8,', WOULD EXCEED THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6817)MAXCOM
 6817   FORMAT('      MAXIMUM NUMBER OF ALLOWED COLUMNS,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IWRITE='OFF'
      CALL L1DIS(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      IF(ICASE.EQ.'ROW')THEN
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ELSEIF(ICASE.EQ.'COLU')THEN
        NR9=NC1
        NC9=NC1
        IUPFLG='FULL'
      ELSE
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ENDIF
      GOTO9000
C
C               *****************************************************
C               **  STEP 69--                                      **
C               **  TREAT THE MATRIX CHEBYCHEV DISTANCE      CASE  **
C               *****************************************************
C
 6900 CONTINUE
C
      IF(ICASE.EQ.'ROW '.AND.NR1.GT.MAXCOM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6911)
 6911   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6913)
 6913   FORMAT('      FOR CHEBYCHEV ROW DISTANCES, THE NUMBER OF ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6915)NR1
 6915   FORMAT('      CREATED COLUMNS, ',I8,', WOULD EXCEED THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,6917)MAXCOM
 6917   FORMAT('      MAXIMUM NUMBER OF ALLOWED COLUMNS,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IWRITE='OFF'
      CALL CHEDIS(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,ICASE,IWRITE,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      IF(ICASE.EQ.'ROW')THEN
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ELSEIF(ICASE.EQ.'COLU')THEN
        NR9=NC1
        NC9=NC1
        IUPFLG='FULL'
      ELSE
        NR9=NR1
        NC9=NR1
        IUPFLG='SUBS'
      ENDIF
      GOTO9000
C
C               *****************************************************
C               **  STEP 70--                                      **
C               **  TREAT THE MATRIX MEAN                    CASE  **
C               *****************************************************
C
 7000 CONTINUE
C
      ITYP9='SCAL'
      D999=0.0D0
      DO7010J=1,NC1
        DO7020I=1,NR1
          D999=D999+DBLE(YM1(I,J))
 7020   CONTINUE
 7010 CONTINUE
      D999=D999/DBLE(NR1*NC1)
      SCAL9=REAL(D999)
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 70.B--                                    **
C               **  TREAT THE MATRIX SUM                     CASE  **
C               *****************************************************
C
 7030 CONTINUE
C
      ITYP9='SCAL'
      D999=0.0D0
      DO7040J=1,NC1
        DO7050I=1,NR1
          D999=D999+DBLE(YM1(I,J))
 7050   CONTINUE
 7040 CONTINUE
      SCAL9=REAL(D999)
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 71--                                      **
C               **  TREAT THE MATRIX ADD ROW                 CASE  **
C               *****************************************************
C
 7100 CONTINUE
C
      IF(NC1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7111)
 7111   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7113)
 7113   FORMAT('      FOR MATRIX ADD ROW, THE NUMBER OF COLUMNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7115)NC1
 7115   FORMAT('      IN THE MATRIX, ',I8,', DOES NOT EQUAL THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7117)N2
 7117   FORMAT('      NUMBER OF ROWS IN THE VARIABLE,  ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO7110J=1,NC1
         DO7120I=1,NR1
           YM9(I,J)=YM1(I,J)
 7120    CONTINUE
         YM9(NR1+1,J)=Y2(J)
 7110 CONTINUE
C
      ITYP9='MATR'
      NC9=NC1
      NR9=NR1+1
      IUPFLG='SUBS'
      GOTO9000
C               *****************************************************
C               **  STEP 72--                                      **
C               **  TREAT THE MATRIX DELETE ROW              CASE  **
C               *****************************************************
C
 7200 CONTINUE
C
      IYS2=INT(YS2+0.5)
      IF(IYS2.LT.1.OR.IYS2.GT.NR1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7211)
 7211   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7213)
 7213   FORMAT('      FOR MATRIX DELETE ROW, THE ROW TO BE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7215)IYS2
 7215   FORMAT('      DELETED IN THE MATRIX, ',I8,', MUST BE >=1')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7217)NR1
 7217   FORMAT('      AND <= ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO7210J=1,NC1
         ICOUNT=0
         DO7220I=1,NR1
           IF(IYS2.NE.I)THEN
             ICOUNT=ICOUNT+1
             YM9(ICOUNT,J)=YM1(I,J)
           ENDIF
 7220    CONTINUE
 7210 CONTINUE
C
      ITYP9='MATR'
      NC9=NC1
      NR9=NR1-1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 73--                                      **
C               **  TREAT THE DISTANCE FROM MEAN             CASE  **
C               *****************************************************
C
 7300 CONTINUE
C
      ICASE='COLU'
      CALL VARCOV(YM1,YM2,MAXROM,MAXCOM,NR1,NC1,DTEMP1,
     1            ICASE,IBUGA3,IERROR)
C
      CALL SGECO(YM2,MAXROM,NC1,INDEX,RCOND,Y1)
      EPS=1.0E-20
      IF(RCOND.LE.EPS)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7371)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,7372)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,7373)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
        GOTO9000
      ENDIF
 7371 FORMAT('*** ERROR FROM MATAR3: UNABLE TO COMPUTE THE INVERSE OF ',
     1       'THE COVARIANCE MATRIX.')
 7372 FORMAT('    PROBLEM: SOME COLUMNS ARE LINEARLY DEPDENDENT ON ',
     1       ' OTHER COLUMNS.')
 7373 FORMAT('    SUGGESTED SOLUTION: WORK WITH A SUBSET OF THE ',
     1       'ORIGINAL COLUMNS.')
C
      IJOB=1
      CALL SGEDI(YM2,MAXROM,NC1,INDEX,Y1,Y2,IJOB)
C
      IWRITE='OFF'
      DO7320I=1,NR1
        DO7330J=1,NC1
          Y3(J)=YM1(I,J)-REAL(DTEMP1(J))
 7330   CONTINUE
        CALL QUAFRM(YM2,MAXROM,MAXCOM,NC1,NC1,Y3,IWRITE,SCAL9,
     1              IBUGA3,IERROR)
        VECT9(I)=SCAL9
 7320 CONTINUE
C
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 74--                                      **
C               **  TREAT THE LINEAR COMBINATION             CASE  **
C               *****************************************************
C
 7400 CONTINUE
C
      IF(N2.NE.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7411)
 7411   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7413)
 7413   FORMAT('      FOR lINEAR COMBINATION, THE NUMER OF ROWS ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7415)N2
 7415   FORMAT('      IN THE VECTOR, ',I8,' DOES NOT EQUAL THE ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7417)NC1
 7417   FORMAT('      NUMBER OF COLUMNS IN THE MATRIX, ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      ICASE='COLU'
      CALL VARCOV(YM1,YM2,MAXROM,MAXCOM,NR1,NC1,DTEMP1,
     1            ICASE,IBUGA3,IERROR)
C
      DO7430J=1,NR1
        DSUM1=0.0D0
        DO7440L=1,NC1
          DSUM1=DSUM1 + DBLE(Y2(L))*DBLE(YM1(J,L))
 7440     CONTINUE
          VECT9(J)=REAL(DSUM1)
 7430   CONTINUE
C
      ITYP9='VECT'
      NVECT9=NR1
      IUPFLG='SUBS'
      GOTO9000
C
C               *****************************************************
C               **  STEP 75--                                      **
C               **  TREAT THE VECTOR TIMES TRANSPOSE         CASE  **
C               *****************************************************
C
 7500 CONTINUE
C
      IF(N1.GT.MAXCOM)THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7501)
 7501 FORMAT('***** ERROR IN MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7502)
 7502 FORMAT('      FOR VECTOR TIMES TRANSPOSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7503)
 7503 FORMAT('      THE NUMBER OF ROWS IN THE VECTOR MUST BE LESS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7504)
 7504 FORMAT('      THAN ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7506)
 7506 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7507)N1
 7507 FORMAT('            NUMBER OF ROWS    =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      ENDIF
C
      DO7520I=1,N1
        DO7530J=1,N1
          YM9(I,J)=Y1(I)*Y1(J)
 7530   CONTINUE
 7520 CONTINUE
C
      ITYP9='MATR'
      NR9=N1
      NC9=N1
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 76--                                        **
C               **  TREAT THE MATRIX GROUP MEANS                CASE **
C               *******************************************************
C
 7600 CONTINUE
C
      IF(NR1.EQ.N2)GOTO7609
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7601)
 7601 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7602)
 7602 FORMAT('      FOR THE MATRIX GROUP MEANS CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7603)
 7603 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7605)
 7605 FORMAT('      THE NUMBER OF ROWS IN THE GROUP ID VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7606)
 7606 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7607)NR1
 7607 FORMAT('            NUMBER OF ROWS FOR MATRIX             =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7608)N2
 7608 FORMAT('            NUMBER OF ROWS FOR GROUP ID VARIABLE  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7609 CONTINUE
C
      CALL GRPMEA(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,
     1Y2,Y3,INDEX,N2,NK,Y4,IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NK
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               *******************************************************
C               **  STEP 77--                                        **
C               **  TREAT THE MATRIX GROUP STANDARD DEVIATIONS  CASE **
C               *******************************************************
C
 7700 CONTINUE
C
      IF(NR1.EQ.N2)GOTO7709
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7701)
 7701 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7702)
 7702 FORMAT('      FOR THE MATRIX GROUP STANDARD DEVIATIONS CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7703)
 7703 FORMAT('      THE NUMBER OF ROWS IN THE MATRIX MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7705)
 7705 FORMAT('      THE NUMBER OF ROWS IN THE GROUP ID VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7706)
 7706 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7707)NR1
 7707 FORMAT('            NUMBER OF ROWS FOR MATRIX             =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7708)N2
 7708 FORMAT('            NUMBER OF ROWS FOR GROUP ID VARIABLE  =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7709 CONTINUE
C
      CALL GRPSD(YM1,YM9,MAXROM,MAXCOM,NR1,NC1,
     1Y2,Y3,INDEX,N2,NK,Y4,IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NK
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 78--                                        **
C     **  TREAT THE MULTIVARIATE NORM RANDOM NUMBERS  CASE **
C     *******************************************************
C
 7800 CONTINUE
C
      IF(N1.EQ.NR2)GOTO7809
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7801)
 7801 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7802)
 7802 FORMAT('      FOR THE MULTIVARIATE NORMAL RANDOM NUMBERS CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7803)
 7803 FORMAT('      THE NUMBER OF ROWS IN THE SIGMA MATRIX MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7805)
 7805 FORMAT('      THE NUMBER OF ROWS IN THE MEAN VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7806)
 7806 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7807)NR1
 7807 FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX       =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7808)N2
 7808 FORMAT('            NUMBER OF ROWS FOR MEAN VARIABLE      =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 7809 CONTINUE
C
      NTEMP=YS3
      LDSIG=MAXROM
      LTF=.TRUE.
      IFLAG=0
C
      DO7820I=1,NTEMP
        CALL RDMNOR(Y1,YM2,LDSIG,NR2,LTF,Y4,IFLAG,ISEED)
        IF(IFLAG.EQ.1)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7821)
 7821     FORMAT('***** ERROR IN MATARI--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7822)
 7822     FORMAT('      FOR THE MULTIVARIATE NORMAL RANDOM NUMBERS ',
     1           'CASE,')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7823)
 7823     FORMAT('      UNABLE TO COMPUTE THE CHOLESKY DECOMPOSITION ',
     1           'OF THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7824)
 7824     FORMAT('      SIGMA MATRIX.  THIS IMPLIES SIGMA IS NOT ',
     1           'POSITIVE DEFINITE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7825)
 7825     FORMAT('      THE MULTIVARIATE RANDOM NUMBERS WERE NOT ',
     1           'GENERATED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        DO7830J=1,NR2
          YM9(I,J)=Y4(J)
 7830   CONTINUE
 7820 CONTINUE
C
      ITYP9='MATR'
      NR9=NTEMP
      NC9=NR2
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 79--                                        **
C     **  TREAT THE MULTINOMIAL  RANDOM NUMBERS       CASE **
C     **  LET M = MULTINOMIAL RANDOM NUMBERS P N NEVENTS   **
C     *******************************************************
C
 7900 CONTINUE
C
      DSUM1=0.0D0
      DO7909I=1,N1
        DSUM1=DSUM1 + DBLE(Y1(I))
        IF(Y1(I).LE.0.0 .OR. Y1(I).GE.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7911)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7901)
 7901     FORMAT('      THE SPECIFIED PROBABILITIES MUST BE IN ',
     1           'THE INTERVAL (0,1).')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7903)I,Y1(I)
 7903     FORMAT('      ROW ',I8,' = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        IF(DSUM1.GT.1.000001D0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7911)
 7911     FORMAT('***** ERROR IN MULTINOMIAL RANDOM NUMBERS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7013)
 7013     FORMAT('      THE SUM OF THE SPECIFIED PROBABILITIES ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7015)
 7015     FORMAT('      HAS JUST EXCEEDED 1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 7909 CONTINUE
C
      NTRIAL=INT(YS2+0.5)
      NEVENT=INT(YS3+0.5)
C
      IF(NTRIAL.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7911)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7916)
 7916   FORMAT('      THE NUMBER OF TRIALS IS LESS THAN 1.  ',
     1         'NTRIALS = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(NEVENT.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7911)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7918)
 7918   FORMAT('      THE NUMBER OF EVENTS IS LESS THAN 1.  ',
     1         'NEVENTS = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NCAT=N1
      IERROR='NO'
C
      DO7920I=1,NEVENT
        CALL MULRAN(NTRIAL,Y1,NCAT,ITEMP1,ISEED,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DO7930J=1,NCAT
          YM9(I,J)=REAL(ITEMP1(J))
 7930   CONTINUE
 7920 CONTINUE
C
      ITYP9='MATR'
      NR9=NEVENT
      NC9=NCAT
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 79.5--                                      **
C     **  TREAT THE MULTINOMIAL PDF                   CASE **
C     **  LET M = MULTINOMIAL PDF X P                      **
C     *******************************************************
C
 7950 CONTINUE
C
      IERROR='NO'
      IF(N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7951)
 7951   FORMAT('***** ERROR IN MULTINOMIAL PDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7953)
 7953   FORMAT('      THE NUMBER OF ROWS IN THE NUMBER OF SUCCESSES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7955)
 7955   FORMAT('      VECTOR AND THE PROBABILITY OF SUCCESS VECTORS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7956)
 7956   FORMAT('      ARE NOT EQUAL.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7957)N1
 7957   FORMAT('            NUMBER OF ROWS FOR NUMBER OF SUCCESSES = '
     1        ,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7958)N2
 7958   FORMAT('            NUMBER OF ROWS FOR PROBABILITY OF ',
     1         'SUCCESS = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO7960I=1,N1
        IF(Y1(I).GE.0.0)THEN
          Y1(I)=REAL(INT(Y1(I)+0.1))
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7951)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7961)
 7961     FORMAT('      THE NUMBER OF SUCCESSES MUST BE A ',
     1           'NON-NEGATIVE INTEGER.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7963)I,Y1(I)
 7963     FORMAT('      ROW ',I8,' = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 7960 CONTINUE
C
      DSUM1=0.0D0
      DO7970I=1,N1
        DSUM1=DSUM1 + DBLE(Y2(I))
        IF(Y2(I).LE.0.0 .OR. Y2(I).GE.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7951)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7971)
 7971     FORMAT('      THE SPECIFIED PROBABILITIES MUST BE IN ',
     1           'THE INTERVAL (0,1).')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7973)I,Y2(I)
 7973     FORMAT('      ROW ',I8,' = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        IF(DSUM1.GT.1.000001D0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7951)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7981)
 7981     FORMAT('      THE SUM OF THE SPECIFIED PROBABILITIES ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7983)
 7983     FORMAT('      HAS JUST EXCEEDED 1.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 7970 CONTINUE
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO7990I=1,N1
        DSUM1=DSUM1+DBLE(Y1(I))
        DSUM2=DSUM2+DBLE(Y2(I))
 7990 CONTINUE
      DN=DSUM1
      DNORM=DSUM2
C
      NTRIAL=INT(DN)
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DLNPDF=DLNGAM(DN+1.0D0)
C
      DO7992I=1,N1
        DLNPDF=DLNPDF - DLNGAM(DBLE(Y1(I) + 1.0D0))
 7992 CONTINUE
      DO7995I=1,N1
        DLNPDF=DLNPDF + DLOG(DBLE(Y2(I))/DNORM)*DBLE(Y1(I))
 7995 CONTINUE
C
      IF(DLNPDF.LT.LOG(CPUMAX))THEN
        DLNPDF=DEXP(DLNPDF)
      ELSE
        WRITE(ICOUT,7998)
 7998   FORMAT('***** WARNING: LOGARITHM OF MULTINOMIAL PDF ',
     1         'RETURNED TO AVOID OVERFLOW.')
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      SCAL9=REAL(DLNPDF)
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 80--                                        **
C     **  TREAT THE WISHART      RANDOM NUMBERS       CASE **
C     **  LET M = WISHART RANDOM NUMBERS MU SIGMA N        **
C     *******************************************************
C
 8000 CONTINUE
C
      IF(N1.EQ.NR2)GOTO8009
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8001)
 8001 FORMAT('***** ERROR IN MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8002)
 8002 FORMAT('      FOR THE WISHART RANDOM NUMBERS CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8003)
 8003 FORMAT('      THE NUMBER OF ROWS IN THE SIGMA MATRIX MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8005)
 8005 FORMAT('      THE NUMBER OF ROWS IN THE MEAN VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8006)
 8006 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8007)NR2
 8007 FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX       =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8008)N1
 8008 FORMAT('            NUMBER OF ROWS FOR MEAN VARIABLE      =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 8009 CONTINUE
C
      IF(NR2.NE.NC2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8011)
 8011   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8012)
 8012   FORMAT('      FOR WISHART RANDOM NUMBERS,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8013)
 8013   FORMAT('      THE NUMBER OF ROWS IN THE SIGMA MATRIX MUST ',
     1         'EQUAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8014)
 8014   FORMAT('      THE NUMBER OF COLUMNS; SUCH WAS NOT THE CASE ',
     1         'HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8017)NR1
 8017   FORMAT('            NUMBER OF ROWS    =',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8018)NC1
 8018   FORMAT('            NUMBER OF COLUMNS =',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      CALL SPOCO(YM2,MAXROM,NR2,RCOND,Y4,INFO)
C
      IF(INFO.NE.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8021)
 8021   FORMAT('***** ERROR IN MATAR3--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8022)
 8022   FORMAT('      FOR MATRIX CHOLESKY DECOMPOSITION,')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8023)
 8023   FORMAT('      THE INPUT MATRIX IS NOT SINGULAR.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
      ENDIF
C
      WRITE(ICOUT,8061)RCOND
      CALL DPWRST('XXX','TEXT ')
 8061 FORMAT('THE RECIPROCAL CONDITION NUMBER FOR THE SIGMA MATRIX = ',
     1       E15.7)
      IF(1.0+RCOND.EQ.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8071)
        CALL DPWRST('XXX','ERRO ')
        WRITE(ICOUT,8072)
        CALL DPWRST('XXX','ERRO ')
        IERROR='YES'
      END IF
 8071 FORMAT('****** ERROR FOR WISHART RANDOM NUMBERS ********')
 8072 FORMAT('       THE SIGMA MATRIX IS SINGULAR')
C
      ICOUNT=0
      DO8080I=1,NR2
      DO8082J=I,NC2
        IF(J.GE.I)THEN
          ICOUNT=ICOUNT+1
          Y2(ICOUNT)=YM2(I,J)
        ENDIF
 8082 CONTINUE
 8080 CONTINUE
C
C
      NTEMP=YS3
      NP=NR2
      NNP=NP*(NP+1)/2
C
      CALL WSHRT(Y2,NTEMP,NP,NNP,Y3,Y4,ISEED)
C
      ICOUNT=0
      DO8090J=1,NP
        DO8092I=1,NP
          IF(I.LE.J)THEN
            ICOUNT=ICOUNT+1
            YM9(I,J)=Y4(ICOUNT)
            IF(I.NE.J)YM9(J,I)=YM9(I,J)
          ENDIF
 8092   CONTINUE
 8090 CONTINUE
C
      ITYP9='MATR'
      NR9=NP
      NC9=NP
      IUPFLG='FULL'
      GOTO9000
C
C               ***********************************************
C               **  STEP 81--                                **
C               **  TREAT THE CATCHER MATRIX CASE            **
C               **  C = X(X'X)**(-1)                         **
C               ***********************************************
C
 8100 CONTINUE
C
      CALL CATCHR(YM1,YM2,YM9,Y1,Y2,INDEX,
     1MAXROM,MAXCOM,NR1,NC1,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               ***********************************************
C               **  STEP 82--                                **
C               **  TREAT THE (X'X)**(-1) MATRIX CASE        **
C               **  C = X(X'X)**(-1)                         **
C               ***********************************************
C
 8200 CONTINUE
C
      CALL XTXINV(YM1,YM9,Y1,Y2,INDEX,
     1MAXROM,MAXCOM,NR1,NC1,
     1IBUGA3,IERROR)
C
      ITYP9='MATR'
      NR9=NC1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               ************************************************
C               **  STEP 83--                                 **
C               **  TREAT THE VARIANCE INFLATION FACTORS CASE **
C               ************************************************
C
 8300 CONTINUE
C
      CALL CATCHR(YM1,YM2,YM9,Y1,Y2,INDEX,
     1MAXROM,MAXCOM,NR1,NC1,
     1IBUGA3,IERROR)
C
      DO8310J=1,NC1
        DSUM1=0.0D0
        DSUM2=0.0D0
        DO8320I=1,NR1
          DSUM1=DSUM1 + DBLE(YM9(I,J))**2
          DSUM2=DSUM2 + DBLE(YM1(I,J))
 8320   CONTINUE
        DMEAN=DSUM2/DBLE(NR1)
        DSUM2=0.0D0
        DO8330I=1,NR1
          DSUM2=DSUM2 + (DBLE(YM1(I,J)) - DMEAN)**2
 8330   CONTINUE
        VECT9(J)=REAL(DSUM1*DSUM2)
 8310 CONTINUE
C
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               ***********************************************
C               **  STEP 84--                                **
C               **  TREAT THE CONDITION INDICES CASE         **
C               **  (USEFUL FOR REGRESSION DIAGNOSTICS)      **
C               ***********************************************
C
 8400 CONTINUE
C
C  SCALE DESIGN MATRIX
C
      DO8410J=1,NC1
        DSUM1=0.0D0
        DO8420I=1,NR1
          DSUM1=DSUM1 + DBLE(YM1(I,J))*DBLE(YM1(I,J))
 8420   CONTINUE
        DSUM1=DSQRT(DSUM1)
        DO8430I=1,NR1
          YM1(I,J)=YM1(I,J)/REAL(DSUM1)
 8430   CONTINUE
 8410 CONTINUE
C
C  COMPUTE SINGULAR VALUES OF SCALED MATRIX
C
      IERR2=0
      AJOB=0.
      BJOB=0.
      AJOB=AJOB*BJOB
      CALL SSVDC(YM1,MAXROM,NR1,NC1,VECT9,Y1,YM1,MAXROM,
     1YM1,MAXROM,Y2,AJOB,IERR2)
C
      DO8440I=1,NC1
        VECT9(I)=VECT9(I)*VECT9(I)
 8440 CONTINUE
C
      CALL MAXIM(VECT9,NC1,IWRITE,XMAX,IBUGA3,IERROR)
      DO8450I=1,NC1
        IF(VECT9(I).NE.0.0)THEN
          VECT9(I)=XMAX/VECT9(I)
        ELSE
          VECT9(I)=0.0
        ENDIF
 8450 CONTINUE
C
      ITYP9='VECT'
      NVECT9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C               ***********************************************
C               **  STEP 85--                                **
C               **  TREAT THE CREATE MATRIX  CASE            **
C               **  LET M = CREATE MATRIX V1 V2 ... VK       **
C               **  NOTE: MOST OF THE REAL WORK OF THIS      **
C               **  FUNCTION ACTUALLY DONE IN DPMAT2, HERE   **
C               **  SIMPLY DOING A MATRIX COPY.              **
C               ***********************************************
C
 8500 CONTINUE
C
      DO8510J=1,NC1
        DO8520I=1,NR1
          YM9(I,J)=YM1(I,J)
 8520   CONTINUE
 8510 CONTINUE
C
      ITYP9='MATR'
      NR9=NR1
      NC9=NC1
      IUPFLG='FULL'
      GOTO9000
C
C     *********************************************************************
C     **  STEP 86--                                                      **
C     **  TREAT THE INDEPENDENT UNIFORM RANDOM NUMBERS  CASE             **
C     **    LET M = INDEPENDENT UNIFORM RANDOM NUMBER LOWLIM UPPLIM NP   **
C     *********************************************************************
C
 8600 CONTINUE
C
      NROW=YS3 + 0.1
      NCOL=N1
C
      DO8620J=1,NCOL
        ATEMP1=AMIN1(Y1(J),Y2(J))
        ATEMP2=ABS(Y2(J)-Y1(J))
        CALL UNIRAN(NROW,ISEED,Y4)
        DO8630I=1,NROW
          YM9(I,J)=ATEMP1 + ATEMP2*Y4(I)
 8630   CONTINUE
 8620 CONTINUE
C
      ITYP9='MATR'
      NR9=NROW
      NC9=NCOL
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 87--                                        **
C     **  TREAT THE MULTIVARIATE NORMAL CDF           CASE **
C     *******************************************************
C
 8700 CONTINUE
C
      IF(NR1.NE.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8701)
 8701   FORMAT('***** ERROR IN MULTIVARIATE NORMAL CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8702)
 8702   FORMAT('      FOR THE MULTIVARIATE NORMAL CDF CASE, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8703)
 8703   FORMAT('      CORRELATION MATRIX MUST BE SQUARE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8706)
 8706   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8707)NR1
 8707   FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX       =',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8708)NC1
 8708   FORMAT('            NUMBER OF COLUMNS FOR SIGMA MATRIX    =',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        N=NR1
      ENDIF
C
      IF(N3.EQ.0)THEN
        IF(N2.NE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8711)
 8711     FORMAT('***** ERROR IN MULTIVARIATE NORMAL CDF--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8712)
 8712     FORMAT('      FOR THE MULTIVARIATE NORMAL CDF CASE, THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8713)
 8713     FORMAT('      NUMBER OF ROWS FOR THE UPPER LIMIT VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8714)
 8714     FORMAT('      NUMBER OF ROWS/COLUMNS FOR THE SIGMA MATRRIX.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8716)
 8716     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8717)NR1
 8717     FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX    ',
     1           '          = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8718)N2
 8718     FORMAT('            NUMBER OF ROWS FOR THE UPPER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ELSE
        IF(N2.NE.N .OR. N3.NE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8721)
 8721     FORMAT('***** ERROR IN MULTIVARIATE NORMAL CDF--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8722)
 8722     FORMAT('      FOR THE MULTIVARIATE NORMAL CDF CASE, THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8723)
 8723     FORMAT('      NUMBER OF ROWS FOR THE UPPER LIMIT VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8724)
 8724     FORMAT('      NUMBER OF ROWS/COLUMNS FOR THE SIGMA MATRRIX.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8726)
 8726     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8727)NR1
 8727     FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX    ',
     1           '          = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8728)N2
 8728     FORMAT('            NUMBER OF ROWS FOR THE LOWER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8729)N3
 8729     FORMAT('            NUMBER OF ROWS FOR THE UPPER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      IF(N.LT.1 .OR. N .GT.20)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8731)
 8731   FORMAT('***** ERROR IN MULTIVARIATE NORMAL CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8732)
 8732   FORMAT('      CORRELATION MATRIX HAS LESS THAN ONE OR MORE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8733)N
 8733   FORMAT('     THAN 20 VARIABLES.   NUMBER OF VARIABLES = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DO8741I=1,N
        DTEMP1(I)=0.0D0
        DTEMP2(I)=0.0D0
        DTEMP3(I)=0.0D0
 8741 CONTINUE
      ICNT=0
      DO8760J=1,N
        DO8765I=1,N
          IF(J.LT.I)THEN
            ICNT=ICNT+1
            INDX=J + ((I-2)*(I-1))/2
            DTEMP1(INDX)=DBLE(YM1(I,J))
          ENDIF
 8765   CONTINUE
 8760 CONTINUE
C
      IF(N3.EQ.0)THEN
        DO8770I=1,N
          ITEMP1(I)=0
          DTEMP3(I)=DBLE(Y2(I))
          DTEMP2(I)=DBLE(Y2(I))
 8770   CONTINUE
      ELSE
        DO8775I=1,N
          ITEMP1(I)=2
          DTEMP2(I)=DBLE(Y2(I))
          DTEMP3(I)=DBLE(Y3(I))
          IF(Y2(I).EQ.CPUMIN.AND.Y3(I).EQ.CPUMAX)THEN
            ITEMP1(I)=-1
            DTEMP2(I)=0.0D0
            DTEMP3(I)=0.0D0
          ELSEIF(Y2(I).EQ.CPUMIN)THEN
            ITEMP1(I)=0
            DTEMP2(I)=DBLE(Y3(I))
            DTEMP3(I)=DBLE(Y3(I))
          ELSEIF(Y3(I).EQ.CPUMAX)THEN
            ITEMP1(I)=1
            DTEMP3(I)=DBLE(Y2(I))
            DTEMP2(I)=DBLE(Y2(I))
          ENDIF
 8775   CONTINUE
      ENDIF
C
      MAXPTS=5000*N*N*N
CCCCC ABSEPS=0.00005D0
CCCCC RELEPS=0.0D0
      ABSEPS=DBLE(ABSE)
      RELEPS=DBLE(RELE)
      VALS=0.0D0
      ERRS=0.0D0
      IFTS=0
C
      IF(IMVNTY.EQ.'SADM')THEN
        CALL SADMVN(N,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSEIF(IMVNTY.EQ.'RANM')THEN
        CALL RANMVN(N,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSEIF(IMVNTY.EQ.'KROM')THEN
        CALL KROMVN(N,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSEIF(IMVNTY.EQ.'SPHM')THEN
        CALL SPHMVN(N,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSE
        CALL SADMVN(N,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ENDIF
C
      IF(IFTS.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8791)
 8791   FORMAT('***** WARNING IN MULTIVARIATE NORMAL CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8792)ABSEPS
 8792   FORMAT('      ERROR IS GREATER THAN REQUESTED VALUE OF ',
     1         E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ITYP9='SCAL'
      SCAL9=REAL(VALS)
      NR9=1
      NC9=1
      IUPFLG='FULL'
      AERROR=ERRS
      GOTO9000
C
C     *******************************************************
C     **  STEP 88--                                        **
C     **  TREAT THE MULTIVARIATE T      CDF           CASE **
C     *******************************************************
C
 8800 CONTINUE
C
      IF(NR1.NE.NC1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8801)
 8801   FORMAT('***** ERROR IN MULTIVARIATE T CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8802)
 8802   FORMAT('      FOR THE MULTIVARIATE T CDF CASE, THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8803)
 8803   FORMAT('      CORRELATION MATRIX MUST BE SQUARE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8806)
 8806   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8807)NR1
 8807   FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX       =',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8808)NC1
 8808   FORMAT('            NUMBER OF COLUMNS FOR SIGMA MATRIX    =',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ELSE
        N=NR1
      ENDIF
C
      IF(N4.EQ.0)THEN
        IF(N3.NE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8811)
 8811     FORMAT('***** ERROR IN MULTIVARIATE T CDF--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8812)
 8812     FORMAT('      FOR THE MULTIVARIATE T CDF CASE, THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8813)
 8813     FORMAT('      NUMBER OF ROWS FOR THE UPPER LIMIT VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8814)
 8814     FORMAT('      NUMBER OF ROWS/COLUMNS FOR THE SIGMA MATRRIX.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8816)
 8816     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8817)NR1
 8817     FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX    ',
     1           '          = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8818)N3
 8818     FORMAT('            NUMBER OF ROWS FOR THE UPPER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ELSE
        IF(N3.NE.N .OR. N4.NE.N)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8821)
 8821     FORMAT('***** ERROR IN MULTIVARIATE T CDF--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8822)
 8822     FORMAT('      FOR THE MULTIVARIATE T CDF CASE, THE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8823)
 8823     FORMAT('      NUMBER OF ROWS FOR THE UPPER LIMIT VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8824)
 8824     FORMAT('      NUMBER OF ROWS/COLUMNS FOR THE SIGMA MATRRIX.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8826)
 8826     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8827)NR1
 8827     FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX    ',
     1           '          = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8828)N3
 8828     FORMAT('            NUMBER OF ROWS FOR THE LOWER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8829)N4
 8829     FORMAT('            NUMBER OF ROWS FOR THE UPPER LIMIT ',
     1           'VECTOR    = ',I8)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
      IF(N.LT.1 .OR. N .GT.20)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8831)
 8831   FORMAT('***** ERROR IN MULTIVARIATE T CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8832)
 8832   FORMAT('      CORRELATION MATRIX HAS LESS THAN ONE OR MORE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8833)N
 8833   FORMAT('     THAN 20 VARIABLES.   NUMBER OF VARIABLES = ',I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NU=INT(YS2+0.1)
C
      DO8841I=1,N
        DTEMP1(I)=0.0D0
        DTEMP2(I)=0.0D0
        DTEMP3(I)=0.0D0
 8841 CONTINUE
      ICNT=0
      DO8860J=1,N
        DO8865I=1,N
          IF(J.LT.I)THEN
            ICNT=ICNT+1
            INDX=J + ((I-2)*(I-1))/2
            DTEMP1(INDX)=DBLE(YM1(I,J))
          ENDIF
 8865   CONTINUE
 8860 CONTINUE
C
      IF(N4.EQ.0)THEN
        DO8870I=1,N
          ITEMP1(I)=0
          DTEMP3(I)=DBLE(Y3(I))
          DTEMP2(I)=DBLE(Y3(I))
 8870   CONTINUE
      ELSE
        DO8875I=1,N
          ITEMP1(I)=2
          DTEMP2(I)=DBLE(Y3(I))
          DTEMP3(I)=DBLE(Y4(I))
          IF(Y3(I).EQ.CPUMIN.AND.Y4(I).EQ.CPUMAX)THEN
            ITEMP1(I)=-1
            DTEMP2(I)=0.0D0
            DTEMP3(I)=0.0D0
          ELSEIF(Y3(I).EQ.CPUMIN)THEN
            ITEMP1(I)=0
            DTEMP2(I)=DBLE(Y4(I))
            DTEMP3(I)=DBLE(Y4(I))
          ELSEIF(Y3(I).EQ.CPUMAX)THEN
            ITEMP1(I)=1
            DTEMP3(I)=DBLE(Y3(I))
            DTEMP2(I)=DBLE(Y3(I))
          ENDIF
 8875   CONTINUE
      ENDIF
C
      MAXPTS=5000*N*N*N
CCCCC ABSEPS=0.00005D0
CCCCC RELEPS=0.0D0
      ABSEPS=DBLE(ABSE)
      RELEPS=DBLE(RELE)
      VALS=0.0D0
      ERRS=0.0D0
      IFTS=0
C
      IF(IMVNTY.EQ.'SADM')THEN
        CALL SADMVT(N,NU,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSEIF(IMVNTY.EQ.'RANM')THEN
        CALL RANMVT(N,NU,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSEIF(IMVNTY.EQ.'KROM')THEN
        CALL KROMVT(N,NU,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ELSE
        CALL SADMVT(N,NU,DTEMP2,DTEMP3,ITEMP1,DTEMP1,
     1              MAXPTS,ABSEPS,RELEPS,ERRS,VALS,IFTS)
      ENDIF
C
      IF(IFTS.EQ.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8891)
 8891   FORMAT('***** WARNING IN MULTIVARIATE T CDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8892)ABSEPS
 8892   FORMAT('      ERROR IS GREATER THAN REQUESTED VALUE OF ',
     1         E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      ITYP9='SCAL'
      SCAL9=REAL(VALS)
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C     *******************************************************
C     **  STEP 89--                                        **
C     **  TREAT THE MULTIVARIATE T    RANDOM NUMBERS  CASE **
C     *******************************************************
C
 8900 CONTINUE
C
      IF(N1.EQ.NR2)GOTO8909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8901)
 8901 FORMAT('***** ERROR IN MATARI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8902)
 8902 FORMAT('      FOR THE MULTIVARIATE T RANDOM NUMBERS CASE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8903)
 8903 FORMAT('      THE NUMBER OF ROWS IN THE SIGMA MATRIX MUST EQUAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8905)
 8905 FORMAT('      THE NUMBER OF ROWS IN THE MEAN VARIABLE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8906)
 8906 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8907)NR1
 8907 FORMAT('            NUMBER OF ROWS FOR SIGMA MATRIX       =',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8908)N2
 8908 FORMAT('            NUMBER OF ROWS FOR MEAN VARIABLE      =',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 8909 CONTINUE
C
      NTEMP=YS4
      LDSIG=MAXROM
      LTF=.TRUE.
C
      DO8920I=1,NTEMP
        CALL RDMNOR(Y1,YM2,LDSIG,NR2,LTF,Y4,IFLAG,ISEED)
        DO8930J=1,NR2
          YM9(I,J)=Y4(J)
 8930   CONTINUE
 8920 CONTINUE
C
C  NOW DIVIDE BY SQRT(CHIRAN(NU)/NU)
C
      NU=INT(YS3+0.1)
      DO8940J=1,NR2
        CALL CHSRAN(NTEMP,NU,ISEED,Y4)
        DO8945I=1,NTEMP
          YM9(I,J)=YM9(I,J)/SQRT(Y4(I)/REAL(NU))
 8945   CONTINUE
 8940 CONTINUE
C
      ITYP9='MATR'
      NR9=NTEMP
      NC9=NR2
      IUPFLG='FULL'
      GOTO9000
C
C     *****************************************************************
C     **  STEP 89.5--                                                **
C     **  TREAT THE DIRICHLET RANDOM NUMBERS  CASE                   **
C     **    LET M = DIRICHLET RANDOM NUMBER ALPHA N                  **
C     *****************************************************************
C
 8950 CONTINUE
C
      NTEMP=YS2 + 0.1
      NRAN=1
C
      DO8959J=1,N1
        IF(Y1(J).LE.0.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8951)
 8951     FORMAT('***** ERROR FOR DIRICHLET RANDOM NUMBERS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8953)
 8953     FORMAT('      THE SHAPE PARAMETERS FOR THE DIRICHLET')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8954)
 8954     FORMAT('      MUST BE POSITIVE.  AT LEAST ONE OF THE SHAPE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8955)
 8955     FORMAT('      PARAMETERS IS NOT POSITIVE.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
 8959 CONTINUE
C
      IF(NTEMP.LT.2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8961)
 8961   FORMAT('***** ERROR FOR DIRICHLET RANDOM NUMBERS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8963)
 8963   FORMAT('      THE REQUESTEND NUMBER OF ROWS MUST BE AT LEAST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8965)
 8965   FORMAT('      ONE.  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      NRAN=1
      DO8970I=1,NTEMP
        DSUM=0.0D0
        DO8980J=1,N1
          CALL GAMRAN(NRAN,Y1(J),ISEED,Y4(J))
          DSUM=DSUM+DBLE(Y4(J))
 8980   CONTINUE
        DO8985J=1,N1
          YM9(I,J)=REAL(DBLE(Y4(J))/DSUM)
 8985   CONTINUE
 8970 CONTINUE
C
      ITYP9='MATR'
      NR9=NTEMP
      NC9=N1
      IUPFLG='FULL'
      GOTO9000
C
C     *****************************************************************
C     **  STEP 93-- -                                                **
C     **  TREAT THE DIRICHLET PDF             CASE                   **
C     **    LET M = DIRICHLET PDF X THETA                            **
C     **    LET M = DIRICHLET LOG PDF X THETA                        **
C     *****************************************************************
C
 9300 CONTINUE
C
      IERROR='NO'
      IF(N1.NE.N2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9351)
 9351   FORMAT('***** ERROR IN DIRICHELET PDF--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9353)
 9353   FORMAT('      THE NUMBER OF ROWS IN THE X VECTOR AND THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9355)
 9355   FORMAT('      ALPHA VECTOR ARE NOT EQUAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9357)N1
 9357   FORMAT('            NUMBER OF ROWS FOR THE X VECTOR     = ',
     1        I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9358)N2
 9358   FORMAT('            NUMBER OF ROWS FOR THE ALPHA VECTOR = ',
     1        I8)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      DSUM1=0.0D0
      DSUM2=0.0D0
      DO9360I=1,N1
        DSUM1=DSUM1+DBLE(Y2(I)-1.0)*DBLE(LOG(Y1(I)))
 9360 CONTINUE
      DLNPDF=DSUM1
C
      DO9370I=1,N1
        DSUM2=DSUM2 + DBLE(Y2(I))
 9370 CONTINUE
      DLNPDF=DLNPDF + DLNGAM(DSUM2)
      DO9380I=1,N1
        DLNPDF=DLNPDF - DLNGAM(DBLE(Y2(I)))
 9380 CONTINUE
C
      SCAL9=REAL(DLNPDF)
      IF(IMCASE.EQ.'DPDF')THEN
        SCAL9=EXP(SCAL9)
      ENDIF
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C     ***********************************************************
C     **  STEP 94--                                            **
C     **  TREAT THE UNIFORM           RANDOM NUMBERS  CASE     **
C     **  (CORRELATED CASE)                                    **
C     **  LET M = MULTIVARIATE UNIFORM RANDOM NUMBERS SIGMA N  **
C     **  ALGORITHM FROM GENTLE (2003), 'RANDOM NUMBER         **
C     **  GENERATION AND MONTE CARLO METHODS', 2ND. ED., P. 207**
C     **  GENERATE NORMAL RANDOM NUMBERS AND THEN TAKE NORCDF  **
C     **  OF THOSE NUMBERS.  NOTE THAT THE LOCATION PARAMETER  **
C     **  IS ASSUMED TO BE ZERO.                               **
C     ***********************************************************
C
 9400 CONTINUE
C
      NTEMP=YS2
      LDSIG=MAXROM
      LTF=.TRUE.
C
      DO9410I=1,NR1
        Y1(I)=0.0
 9410 CONTINUE
C
      DO9420I=1,NTEMP
        CALL RDMNOR(Y1,YM1,LDSIG,NR1,LTF,Y4,IFLAG,ISEED)
        DO9430J=1,NR1
          CALL NORCDF(Y4(J),YM9(I,J))
 9430   CONTINUE
 9420 CONTINUE
C
      ITYP9='MATR'
      NR9=NTEMP
      NC9=NR1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 95--                                      **
C               **  TREAT THE MATRIX PARTITION STATISTIC     CASE  **
C               *****************************************************
C
C  THIS COMMAND SPLITS THE FULL MATRIX INTO SUB-PARTITIONS
C  (DETERMINED BY NROWPA AND NCOLPA) AND CREATE A NEW MATRIX
C  CONTAINING THE COMPUTED STATISTIC FOR EACH OF THESE SUB-MATRICES.
C
C  TWO CASES ARE SUPPORTED:
C
C  1) IF THE SECOND AND THIRD ARGUMENTS ARE BOTH SCALAR, THEN
C     EXTRACT EQUI-SIZED PARTITIONS.
C
C  2) IF EITHER THE SECOND OR THIRD ARGUMENT IS A VECTOR, THEN
C     EXTRACT UNEQUAL PARTITIONS.  THE VECTOR IS TREATED AS A
C     TAG VARIABLE WHICH IDENTIFIES THE SUB-MATRICES.  WITH THIS
C     APPROACH, THE SUB-MATRICES DO NOT NEED TO BE OF EQUAL SIZE
C     AND DO NOT NEED TO DEFINE CONTIGUOUS SUBSETS.
C
 9500 CONTINUE
C
      IWRITE='OFF'
      MAXNXT=MAXOBV
C
      NROWPA=INT(ABS(YS2+0.5))
      NCOLPA=INT(ABS(YS3+0.5))
      IF(N2.LE.0 .AND. N3.LE.0)THEN
C
        IF(NROWPA.EQ.0)NROWPA=2
        IF(NCOLPA.EQ.0)NCOLPA=2
C
        IROW=0
        ICOL=0
        DO9510I=1,NC1,NCOLPA
          ICOL=ICOL+1
          ICOL1=I
          ICOL2=I+NCOLPA-1
          IF(ICOL2.GT.NC1)ICOL2=NC1
          IROW=0
          DO9515J=1,NR1,NROWPA
            IROW=IROW+1
            IROW1=J
            IROW2=J+NROWPA-1
            IF(IROW2.GT.NR1)IROW2=NR1
            III=0
            DO9520II=ICOL1,ICOL2
              DO9530JJ=IROW1,IROW2
                III=III+1
                NTEMP=III
                Y1(III)=YM1(JJ,II)
 9530         CONTINUE
 9520       CONTINUE
            ASTAT=0.0
            CALL CMPSTA(
     1    Y1,Y2,Y3,Y4,Y5,MAXNXT,NTEMP,NTEMP,NUMV2,ICASS7,
     1    ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1    IQUAME,IQUASE,
     1    ASTAT,
     1    ISUBRO,IBUGA3,IERROR)
            YM9(IROW,ICOL)=ASTAT
 9515     CONTINUE
 9510   CONTINUE
C
        ITYP9='MATR'
        NR9=IROW
        NC9=ICOL
        IUPFLG='FULL'
        GOTO9000
C
      ELSE
C
        IF(N2.GE.1)THEN
          IF(N2.NE.NR1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9551)
 9551       FORMAT('***** ERROR IN MATRIX PARTITION <STATISTIC>--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9552)N2
 9552       FORMAT('      THE NUMBER OF ELEMENTS IN THE ROW VECTOR ',
     1             '= ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9553)NR1
 9553       FORMAT('      WHILE THE NUMBER OF ROWS IN THE MATRIX = ',
     1             I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          CALL DISTIN(Y2,N2,IWRITE,Y5,NROWPA,IBUGA3,IERROR)
          DO9557I=1,NROWPA
            DTEMP1(I)=DBLE(Y5(I))
 9557     CONTINUE
        ELSE
          NROWPA=1
          DTEMP1(1)=1.0D0
          DO9558I=1,NR1
            Y2(I)=1.0
 9558     CONTINUE
        ENDIF
C
        IF(N3.GE.1)THEN
          IF(N3.NE.NC1)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9561)
 9561       FORMAT('***** ERROR IN MATRIX PARTITION <STATISTIC>--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9562)N2
 9562       FORMAT('      THE NUMBER OF ELEMENTS IN THE COLUMN ',
     1             'VECTOR = ',I8)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9563)NC1
 9563       FORMAT('      WHILE THE NUMBER OF COLUMNS IN THE ',
     1             'MATRIX = ',I8)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          CALL DISTIN(Y3,N3,IWRITE,Y5,NCOLPA,IBUGA3,IERROR)
          DO9567I=1,NCOLPA
            DTEMP2(I)=DBLE(Y5(I))
 9567     CONTINUE
        ELSE
          NCOLPA=1
          DTEMP2(1)=1.0D0
          DO9568I=1,NC1
            Y3(I)=1.0
 9568     CONTINUE
        ENDIF
C
        DO9571IROW=1,NROWPA
          AROW=REAL(DTEMP1(IROW))
          DO9572ICOL=1,NCOLPA
            ACOL=REAL(DTEMP2(ICOL))
C
            NTEMP=0
            DO9580JJ=1,NC1
              DO9590II=1,NR1
                IF(AROW.EQ.Y2(II) .AND. ACOL.EQ.Y3(JJ))THEN
                  NTEMP=NTEMP+1
                  Y1(NTEMP)=YM1(II,JJ)
                ENDIF
 9590         CONTINUE
 9580       CONTINUE
            IF(NTEMP.GE.1)THEN
              ASTAT=0.0
              CALL CMPSTA(
     1        Y1,Y5,YM2(1,1),YM2(1,2),YM2(1,3),MAXNXT,
     1        NTEMP,NTEMP,NUMV2,ICASS7,
     1        ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1        IQUAME,IQUASE,
     1        ASTAT,
     1        ISUBRO,IBUGA3,IERROR)
              YM9(IROW,ICOL)=ASTAT
            ELSE
              YM9(IROW,ICOL)=0.0
            ENDIF
 9572     CONTINUE
 9571   CONTINUE
C
        ITYP9='MATR'
        NR9=NROWPA
        NC9=NCOLPA
        IUPFLG='FULL'
        GOTO9000
C
      ENDIF
C
C               *****************************************************
C               **  STEP 96--                                      **
C               **  TREAT THE MATRIX STATISTIC               CASE  **
C               *****************************************************
C
C  THIS COMMAND COMPUTES A SPECIFIED STATISTIC FOR THE ENTIRE MATRIX.
C
 9600 CONTINUE
C
      IWRITE='OFF'
      MAXNXT=MAXOBV
C
      ICNT=0
      DO9610I=1,NC1
        DO9620J=1,NR1
          ICNT=ICNT+1
          IF(ICNT.GT.MAXOBV)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9611)
 9611       FORMAT('***** ERROR FROM MATRIX STATISTIC--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9613)MAXOBV
 9613       FORMAT('      THE NUMBER OF ELEMENTS IS GREATER THAN ',
     1             I10)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          Y1(ICNT)=YM1(I,J)
 9620   CONTINUE
 9610 CONTINUE
      ASTAT=0.0
      CALL CMPSTA(
     1    Y1,Y2,Y3,Y4,Y5,MAXNXT,ICNT,ICNT,NUMV2,ICASS7,
     1    ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1    IQUAME,IQUASE,
     1    ASTAT,
     1    ISUBRO,IBUGA3,IERROR)
C
      SCAL9=ASTAT
      ITYP9='SCAL'
      NR9=1
      NC9=1
      IUPFLG='FULL'
      GOTO9000
C
C               *****************************************************
C               **  STEP 97--                                      **
C               **  TREAT THE MATRIX BIN                     CASE  **
C               *****************************************************
C
C  THIS COMMAND BINS THE DATA IN A MATRIX (I.E., USEFUL FOR
C  GENERATING A HISTOGRAM OF ALL THE POINTS IN THE MATRIX.
C
 9700 CONTINUE
C
      IWRITE='OFF'
      MAXNXT=MAXOBV
C
      ICNT=0
      DO9710I=1,NC1
        DO9720J=1,NR1
          ICNT=ICNT+1
          IF(ICNT.GT.MAXOBV)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9711)
 9711       FORMAT('***** ERROR FROM MATRIX STATISTIC--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,9713)MAXOBV
 9713       FORMAT('      THE NUMBER OF ELEMENTS IS GREATER THAN ',
     1             I10)
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          Y1(ICNT)=YM1(J,I)
 9720   CONTINUE
 9710 CONTINUE
C
      CALL DPBIN(Y1,ICNT,IRELAT,CLWID,XSTART,XSTOP,IRHSTG,
     1           Y4,MAXNXT,IHSTCW,
     1           Y2,Y3,N2,IBUGA3,IERROR)
C
      ITYP9='VECT'
      NVECT9=N2
      IUPFLG='FULL'
      DO9760I=1,NVECT9
        VECT9(I)=Y2(I)
        Y2(I)=Y3(I)
 9760 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ATR3')GOTO9090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF MATAR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4
 9012 FORMAT('IBUGA3,ISUBRO,IMCASE,ITYPA1,ITYPA2,ITYPA3,ITYPA4 = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IMCASE,IMSUBC
 9013 FORMAT('IMCASE,IMSUBC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMVAR,IWRITE
 9014 FORMAT('NUMVAR,IWRITE = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)YS1,YS2,YS3,YS4
 9015 FORMAT('YS1,YS2,YS3,YS4 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IERROR
 9016 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IYS2,IYS3,IYS23,NRJ,NCJ
 9017 FORMAT('IYS2,IYS3,IYS23,NRJ,NCJ = ',5I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NR1,NC1
 9031 FORMAT('NR1,NC1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR1.LE.0)GOTO9039
      IF(NC1.LE.0)GOTO9039
      JMAX=NC1
      IF(JMAX.GT.10)JMAX=10
      DO9032I=1,NR1
      WRITE(ICOUT,9033)I,(YM1(I,J),J=1,JMAX)
 9033 FORMAT('I,YM1(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9039 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NR2,NC2
 9041 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9049
      IF(NC2.LE.0)GOTO9049
      JMAX=NC2
      IF(JMAX.GT.10)JMAX=10
      DO9042I=1,NR2
      WRITE(ICOUT,9043)I,(YM2(I,J),J=1,JMAX)
 9043 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9049 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NR9,NC9
 9051 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9059
      IF(NC9.LE.0)GOTO9059
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9055I=1,NR9
      WRITE(ICOUT,9056)I,(YM9(I,J),J=1,JMAX)
 9056 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9055 CONTINUE
 9059 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9111)N1
 9111 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N1.LE.0)GOTO9119
      DO9112I=1,N1
      WRITE(ICOUT,9113)I,Y1(I)
 9113 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9112 CONTINUE
 9119 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9121)N2
 9121 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N2.LE.0)GOTO9129
      DO9122I=1,N2
      WRITE(ICOUT,9123)I,Y2(I)
 9123 FORMAT('I,Y2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9122 CONTINUE
 9129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9131)N3
 9131 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N3.LE.0)GOTO9139
      DO9132I=1,N3
      WRITE(ICOUT,9133)I,Y3(I)
 9133 FORMAT('I,Y3(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9132 CONTINUE
 9139 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9141)N4
 9141 FORMAT('N4 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N4.LE.0)GOTO9149
      DO9142I=1,N4
      WRITE(ICOUT,9143)I,Y4(I)
 9143 FORMAT('I,Y4(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9142 CONTINUE
 9149 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9151)ITYP9,SCAL9
 9151 FORMAT('ITYP9,SCAL9 = ',A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9161)NVECT9
 9161 FORMAT('NVECT9 = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NVECT9.LE.0)GOTO9169
      DO9162I=1,NVECT9
      WRITE(ICOUT,9163)I,VECT9(I)
 9163 FORMAT('I,VECT9(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9162 CONTINUE
 9169 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9171)NR9,NC9
 9171 FORMAT('NR9,NC9 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR9.LE.0)GOTO9179
      IF(NC9.LE.0)GOTO9179
      JMAX=NC9
      IF(JMAX.GT.10)JMAX=10
      DO9172I=1,NR9
      WRITE(ICOUT,9173)I,(YM9(I,J),J=1,JMAX)
 9173 FORMAT('I,YM9(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9172 CONTINUE
 9179 CONTINUE
C
      IF(IMCASE.NE.'MASS')GOTO9189
      WRITE(ICOUT,9181)NR2,NC2
 9181 FORMAT('NR2,NC2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NR2.LE.0)GOTO9189
      IF(NC2.LE.0)GOTO9189
      JMAX=NC2+1
      IF(JMAX.GT.10)JMAX=10
      NR2P1=NR2+1
      DO9182I=1,NR2P1
      WRITE(ICOUT,9183)I,(YM2(I,J),J=1,JMAX)
 9183 FORMAT('I,YM2(I,.) = ',I8,10E10.3)
      CALL DPWRST('XXX','BUG ')
 9182 CONTINUE
CCCCC WRITE(ICOUT,9187)NR2,NLTZ,NGTZ,NEQZ
C9187 FORMAT('NR2,NLTZ,NGTZ,NEQZ = ',4I8)
      WRITE(ICOUT,9187)NR2
 9187 FORMAT('NR2 = ',I8)
      CALL DPWRST('XXX','BUG ')
 9189 CONTINUE
C
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE MATCH(X,Z,NX,VAL,NVAL,IWRITE,Y,ICASE,IBUGA3,IERROR)
C
C     PURPOSE--MATCH EACH VALUE IN THE VALUE ARRAY TO THE
C              CLOSEST VALUE IN THE X ARRAY.  THE RETURNED
C              Y ARRAY WILL CONTAIN THE CORRESPONDING INDEX
C              VALUES OF THE X ARRAY (I.E., DON'T RETURN
C              THE MATCHING VALUE, JUST THE INDEX OF THE
C              MATCHING VALUE).
C              IF ICASE IS TRAN, THEN RETURN THE VALUE OF THE
C              ARRAY Z CORRESPONDING TO INDEX.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2001/10
C     ORIGINAL VERSION--OCTOBER   2001.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES----------------
C
      CHARACTER*4 ICASE
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C
C------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION VAL(*)
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='MATC'
      ISUBN2='H   '
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 MATCH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NX
   53 FORMAT('NX = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NX
      WRITE(ICOUT,56)I,X(I),VAL(I)
   56 FORMAT('I,X(I), VAL(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  COMPUTE INDICES OF MATCHING VALUES *
C               ****************************************
C
      DO100I=1,NVAL
        VALTMP=VAL(I)
        INDTMP=1
        YDIFF=CPUMAX
        DO200J=1,NX
          APROD=X(J)*VALTMP
          TERM1=MAX(X(J),VALTMP)
          TERM2=MIN(X(J),VALTMP)
          IF(APROD.GT.0.0)THEN
            ADIFF=ABS(ABS(TERM1) - ABS(TERM2))
          ELSEIF(APROD.LT.0.0)THEN
            ADIFF=TERM1+ABS(TERM2)
          ELSE
            ADIFF=ABS(TERM1-TERM2)
          ENDIF
          IF(ADIFF.LT.YDIFF)THEN
            INDTMP=J
            YDIFF=ADIFF
          ENDIF
  200   CONTINUE
        IF(ICASE.EQ.'INDE')THEN
          Y(I)=REAL(INDTMP)
        ELSE
          Y(I)=Z(INDTMP)
        ENDIF
  100 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 MATCH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NX
 9013 FORMAT('NX = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NX
      WRITE(ICOUT,9016)I,X(I),Y(I)
 9016 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
